(load "/usr/local/slisp/station.lsp")

(defvar audio-choice-num nil)
(defvar preferred-audio (list '("eng" "en") '("wel" "cym") '("gae") '("und")))
(defvar preferred-audio-format nil)
(defvar unlock-file nil)

(defmacro get-track-pid (track)
  `(first ,track))
(defmacro get-track-tag (track)
  `(second ,track))
(defmacro get-track-audio-format (track)
  `(first (third ,track)))
(defmacro get-track-audio-lang (track)
  `(second (third ,track)))
(defmacro get-track-audio-type (track)
  `(third (third ,track)))
(defmacro get-track-audio-adpid (track)
  `(fourth (third ,track)))
(defmacro set-track-audio-adpid (track val)
  `(setf (nth 3 (nth 2 ,track)) ,val))
(defmacro tag2pid (tag lst)
  `(first (find-if #'(lambda (x)
		       (eq ,tag (second x)))
		   ,lst)))
(defun get-preferred-priority (preferred lang)
  (let ((pri))
    (setf pri (position-if #'(lambda (x)
			       (find-if #'(lambda (y)
					    (string-equal lang y))
					x))
			   preferred))
    (if pri
	pri
      (length preferred))))
(defun get-format-priority (preferred format)
  (if (member format preferred)
      0
    1))
(defun append-audio-track (track lst) 
  (when (or (not audio-choice-num) (< (length lst) audio-choice-num))
    (let ((pos nil))
      (setf pos (position-if #'(lambda (x)
				 (or (< (get-format-priority preferred-audio-format (get-track-audio-format track))
					(get-format-priority preferred-audio-format (get-track-audio-format x)))
				     (when (= (get-format-priority preferred-audio-format (get-track-audio-format track))
					      (get-format-priority preferred-audio-format (get-track-audio-format x)))
				       (or (< (get-track-audio-type track) (get-track-audio-type x))
					   (and (= (get-track-audio-type track) (get-track-audio-type x))
						(< (get-preferred-priority preferred-audio (get-track-audio-lang track)) 
						   (get-preferred-priority preferred-audio (get-track-audio-lang x))))))))
			     lst))
      (if (not pos)
	  (setf-cdr (last lst) (cons track nil))
	(setf-nthcdr pos lst (cons (nth pos lst) (nthcdr (1+ pos) lst)))
	(setf-nth pos lst track)))))
(defun child-lock-p (key)
  (and (eq (svl-get-data (get-signal-source-svl key) 'child-lock) 1)
       (not (file-close (file-open unlock-file 'read)))))
(defun pmt-parser (pmt key)
  (if (or (not pmt) (child-lock-p key))
      (progn
	(set-video-pid 'video nil)
	(set-audio-pid 'audio nil))
    (let ((header) (firstlp) (secondlp) (esheader) (esdesclp)
	  (stype) (espid) (tag) (track) (lang) (type)
	  (vlist nil) (alist nil) (calist nil))
      (setf header (first pmt))
      (setf firstlp (second pmt))
      (setf secondlp (third pmt))
      (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))))))
			  esdesclp)
		  (case stype
		    ((#x01 #x02)
		     (setf track (list espid tag nil))
		     (if vlist
			 (setf-cdr (last vlist) (cons track nil))
		       (setf vlist (cons track nil))))
		    ((#x03 #x04)
		     (setf track (list espid tag (list stype lang type -1)))
		     (if alist
			 (append-audio-track track alist)
		       (setf alist (cons track nil)))))
		  (if calist
		      (setf-cdr (last calist) (cons (list espid 0) nil))
		    (setf calist (cons (list espid 0) nil))))
	      secondlp)
      (set-video-pid 'video (if (assoc (get-video-pid 'video) vlist)
				(get-video-pid 'video)
			      (get-track-pid (car vlist))))
      (set-audio-pid 'audio (if (assoc (get-audio-pid 'audio) alist)
				(get-audio-pid 'audio)
			      (get-track-pid (car alist)))))))
(register-device 'audio-desc
		 "audio"
		 (get-default-prio)
		 #'(lambda (sig)
		     (case sig
		       (AVAILABLE
			(set-owner 'audio-desc t))
		       (LOST
			(set-owner 'audio-desc nil)))))
(defun allocate-resource ()
  (my-device-open 'video 0)
  (my-device-open 'audio 0)
  (my-device-open 'audio-desc 1)
  (my-device-open 'psi 0)
  (my-device-open 'tsport 0)
  (my-device-open 'tuner 0)
  (init-tuner-object 'tuner)
  (init-section-object 'pat)
  (init-section-object 'pmt)
  (init-psi-object 'psi #'pmt-parser)
  (init-video-object 'video)
  (init-audio-object 'audio)
  (when (owner-p 'tuner)
    1))
  
(defun digital-program-on (src sym onid tsid svcid)
  (let ((svl-key) (tsl-key) (dev))
    (setf svl-key (svl-create-key sym
				  :onid onid
				  :tsid tsid
				  :svcid svcid))
    (setf tsl-key (svl-create-key "TSL"
				  :ch (svl-get-data svl-key 'ch)
				  :onid onid
				  :tsid tsid))
    (set-signal-source-svl src svl-key)
    (set-signal-source-tsl src tsl-key)
    (set-tuning-tsl-key tsl-key)
    (set-tuning-tsid tsid)
    (set-tuning-svcid svcid)

    (if (get-signal-source-devices src)
	(progn
	  (audio-stop 'audio-desc)
	  (select-channel))
      (set-signal-source-devices src (list 'tuner 'video 'audio 'audio-desc 'psi 'tsport))
      (unless (eq (get-tuning-svcid) (get-psi-svcid 'psi))
	(when (psi-invalidate 'psi)
	  (set-psi-valid 'psi nil)
	  (setf new-svcid nil)))
      (audio-stop 'audio-desc)
      (eval-node (get-signal-source-node src)))))

(init-signal-source-object 'mheg)
(tuner-config 'tuner "ttuner")
(set-signal-source-tuner 'mheg 'tuner)
(set-signal-source-no 'mheg 0)
(append-t 
 'tuner-freq-valid
 'tuner-connect
 'tsport-connect
 'psi-valid
 'parse-pmt
 'video-pid-valid
 'video-play)

(append-t
 'tsport-connect
 'pat-request
 'svcid-check
 'pmt-pid-valid
 'pmt-request)
  
(append-t
 'parse-pmt
 'audio-pid-valid
 'audio-play)
    
(node-key 'tuner-freq-valid 'mheg)
(set-signal-source-node 'mheg 'tuner-freq-valid)

(defun c-program-on (sym arg)
  (when (eq (length arg) 3)
    (digital-program-on 'mheg sym (first arg) (second arg) (third arg))))
(defun c-program-off ()
  (cancel-node (get-signal-source-node 'mheg))
  (mapcar #'(lambda (x)
	      (my-device-close x))
	  (get-signal-source-devices 'mheg))
  (set-signal-source-devices 'mheg nil)
  (set-signal-source-svl 'mheg nil)
  (set-signal-source-tsl 'mheg nil))
(defun set-unlock-file (name)
  (setf unlock-file name))
(defun set-preferred-audio (pref)
  (setf preferred-audio pref))
