;;; monk-real.el --- RealMedia track generator module for MonK

;; (c) 2003 Seiichi Namba <sn@asahi-net.email.ne.jp>
;; Started: Mon Jun 16 22:00:19 2003

;;
;; REQUIREMENT: trplayer-1.2.0: http://www.linux-speakup.org/trplayer.html
;;
;; BUGS: 
;;    (1) Uses patched version of trplayer (can you build it ?).
;;    (2) Audio playback only (trplayer-1.2.0 supports audio only).
;;    (3) Local file only (perhaps ?).
;;    (4) Track playing will be automatically stopped when probe.
;;

;;
;; The track to be built by this module looks like:
;;
;; ((file . "~/mp3/Diana_Darby-Ragdoll.rm")
;;  (player . "trplayer")
;;  (track-opt)
;;  (offset-opt . "-j %s")
;;  (duration-opt . "-t %s")
;;  (options)
;;  (post-filter)
;;  (frames . 226.15)
;;  (time . 226.15)
;;  (cent . 2.2615)
;;  (fps . 1)
;;  (type . rmf))
;;
;; As you can see, `time' property should be used as frames, and to
;; compute `cent' (frames / 100).  This is mostly because `trplayer'
;; (patched) requires that the argument for "-j" should be in second.
;; Accordingly `fps' is 1.
;;

;; Assumes that the patched `trplayer' should support
;; probe format like this:

;; Bit rate is 16K
;; Length is 2 minutes and 32 seconds
;; Title: Toccata
;; Author: JS Bach
;; Copyright: 1994 Philip Hii
;; Seeking  Rate:  16K  Time: 00:00:00   0% of 00:02:32

(require 'monk)
(require 'dired)
(require 'dired-aux)
(provide 'monk-real)

(defconst monk-real-version "0.1")

(defvar monk-real-probe-command "trplayer")
(defvar monk-real-probe-options '("-p"))

(defvar monk-real-player "trplayer" "Should be \"trplayer\".")
(defvar monk-real-player-options nil "For `monk-real-player'")

(defvar monk-real-player-offset-opt "-j %s")
(defvar monk-real-player-duration-opt "-t %s")
(defvar monk-real-player-post-filter nil)

(defvar monk-real-readin-wait 0
  "A delay in second inserted after reading .rm file.")

(defun monk-real-stop-process-mutex ()
  "Stop all the playing track exclusive to RealMedia track probing."
  (let ((track '((type . rmf))))
    (when (equal (monk-stop-process-mutex track 'keeploop) '(()))
      (message "MonK stopped playing track to probe RealMedia file."))))

;;
;; Parser
;;

(defsubst monk-real-parse-info (buf)
  "Parse BUF, to get info from `monk-real-probe-command' output.
Should return list."
  (let ((re1 "0% of [0-9][0-9]:\\([0-9][0-9]:[0-9][0-9]\\)") ; time
	(re2 "^Bit rate is \\([0-9]+\\)K")) ; bitrate
    (save-excursion
      (set-buffer buf)
      (save-match-data
	(goto-char (point-min))
	(when (search-forward-regexp re1 nil t)
	  (list
	   (cons 'time
		 (setq time
		       (monk-cdtime2sec
			(buffer-substring-no-properties
			 (match-beginning 1) (match-end 1)))))
	   (cons 'frames time)
	   (cons 'cent (/ time 100.0))
	   (cons 'fps 1)
	   (cons 'type 'rmf)
	   (cons 'bitrate
		 (progn (goto-char (point-min))
		       (when (search-forward-regexp re2 nil t)
			 (string-to-number
			  (buffer-substring-no-properties
			   (match-beginning 1) (match-end 1))))))
	   (cons 'spec (dired-split
			"\n"
			(buffer-substring-no-properties
			 (point-min) (point-max))))))))))

;; (monk-real-parse-info (current-buffer)) =>
;; ((time . 197.0)
;;  (frames . 197.0)
;;  (cent . 1.97)
;;  (fps . 1)
;;  (type . rmf)
;;  (bitrate . 16)
;;  (spec "Bit rate is 16K"
;;        "Length is 3 minutes and 17 seconds"
;;        "Seeking  Rate:  16K  Time: 00:00:00   0% of 00:03:17"
;;        "Title: Whispers"
;;        "Author: Philip Hii"
;;        "Copyright: 1998 Philip Hii"
;;        ""))

;;
;; Brand new in 0.6, uses the new function `monk-real-probe'.
;;

(defun monk-real-get-info (file)
  "Get info including track timing, frames etc. from FILE with mpg123\(1\).
Current version does not use shell, `dired-shell-stuff-it', and \">/dev/null\"
anymore.  See `monk-real-probe-command', and `monk-real-probe-options'."
  (let ((buf (get-buffer-create monk-info-buffer)) tem)
    (save-excursion
      (set-buffer buf) (erase-buffer)
      (setq default-directory
	    (monk-put-trailing-/ (file-name-directory file)))

      ;; Stop playing, otherwise probe will be stuck.
      (monk-real-stop-process-mutex)

      (cond
       ( ;; (= 0 ;; Sometimes "Hangup" is returned in E19.28 instead of 0
	(setq tem ;; hack `tem' if debug required.
	    (apply 'call-process monk-real-probe-command nil t nil
			    (append monk-real-probe-options
				    (list
				     file ; expanded already
				     ))))
	;; Delay. Recursive directory read sometimes failed.
	;; mpg123 is hard to deal with.  Must be put here (or where ?)
	;; (sleep-for (/ monk-wait-proc-to-die 2)) ; may be too short...
	(sleep-for monk-real-readin-wait)
	(cons (cons (quote file) file)
	      (monk-real-parse-info buf)))))))

;;
;; The track builder, still the same as of 0.5 in 0.6
;;

(defun monk-real-build-track-obj (file)
  "Get info from real file FILE, and build track object for the FILE.
`monk-real-get-info' is called."
  (let ((info (monk-real-get-info (expand-file-name file))))
    (when info
      (append (list
	       (cons 'player monk-real-player)
	       (cons 'track-opt nil)
	       (cons 'offset-opt monk-real-player-offset-opt)
	       (cons 'duration-opt monk-real-player-duration-opt)
	       (cons 'options monk-real-player-options)
	       (cons 'post-filter monk-real-player-post-filter))
	      info))))

(defun monk-real-insert-track-obj (file)
  "Insert track line at point."
  (let (obj fname frames time brate)
    (setq obj (monk-real-build-track-obj file)
	  frames (monk-assq-get-value 'frames obj)
	  time (monk-assq-get-value 'time obj))
    (cond ((and obj frames)
	   (setq
	    fname (file-name-nondirectory (monk-assq-get-value 'file obj))
	    ;; title (monk-assq-get-value 'title obj)
	    ;; artist (monk-assq-get-value 'artist obj)
	    brate (monk-assq-get-value 'bitrate obj))
	   (monk-insert-track
	    obj
	    "rmf:"
	    (format "%5s.00" (monk-sec2cdtime time))
	    (if brate
		(format "%3.1fk/s" brate)
	      "unknown")
	    frames
	    (format "\"%s\"" fname) 'newline)
	   obj)
	  (t (message "Track build faild for file: %s" file)))))

;;
;; Should merge equivalent codes into monk.el as default of these variables later
;;

(when (null (assq 'rmf monk-type-group-alist))
  (setq monk-track-generator-list
 	(cons 
 	 '("\\.ra*m$" monk-real-insert-track-obj monk-real)
 	 monk-track-generator-list))
  (setq monk-type-group-alist
 	(cons '(rmf . dsp) monk-type-group-alist)))