;; -*-Emacs-Lisp-*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or         ;;
;; modify it under the terms of the GNU General Public License as        ;;
;; published by the Free Software Foundation; either version 3, or (at   ;;
;; your option) any later version.                                       ;;
;;                                                                       ;;
;; This program is distributed in the hope that it will be useful, but   ;;
;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
;; General Public License for more details.                              ;;
;;                                                                       ;;
;; You should have received a copy of the GNU General Public License     ;;
;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
;;                                                                       ;;
;; Written by and Copyright (C) Francois Fleuret                         ;;
;; Contact <francois@fleuret.org> for comments & bug reports             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Is it me, or the slave mode of mplayer is ugly to parse? Did I miss
;; something?

(defcustom media/mplayer/executable "mplayer"
  "The name of the executable."
  :type 'string
  :group 'media)

(defcustom media/mplayer/args nil
  "List of arguments for mplayer."
  :type 'list
  :group 'media)

(defcustom media/mplayer/timing-request-period 0.25
  "Period for the timing requests in second(s). Larger values
load Emacs less. Nil means no timing."
  :type 'float
  :group 'media)

(defcustom media/mplayer/capture-dir nil
  "States where to save the dumped streams."
  :type 'string
  :group 'media)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; It is impossible to tell mplayer to send information every time dt
;; or so, hence this mess with a timer to avoid overloading emacs with
;; the processing of the information

(defvar media/mplayer/timer nil
  "A timer to request the timing position.")

(defun media/mplayer/timing-request ()
  (if media/mplayer/process
      (unless media/mplayer/paused
        (media/mplayer/write "get_time_pos\n")
        )
    (media/mplayer/stop-timing-requests)
    ))

(defun media/mplayer/start-timing-requests ()
  (when media/mplayer/timing-request-period
    (media/mplayer/stop-timing-requests)
    (setq media/mplayer/timer
          (run-at-time nil
                       media/mplayer/timing-request-period
                       'media/mplayer/timing-request))
    )
  )

(defun media/mplayer/stop-timing-requests ()
  (when media/mplayer/timer
    (cancel-timer media/mplayer/timer)
    (setq media/mplayer/timer nil)
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq media/mplayer/protocol-regexp
      "^\\(AUDIO:\\|Exiting...\\|Starting\\|ANS_LENGTH\\|ANS_TIME_POSITION\\|Cache fill:\\|ICY Info:\\) *\\(.*\\)$")

(defun media/mplayer/filter-subfunctions (cmd param)
  ;; (unless (string= cmd "A:")
  ;; (message "cmd=%s param=%s" cmd param)
  ;; )
  (eval
   (cons 'progn
         (cdr
          (assoc cmd

                 '(
                   ("ICY Info:"
                    ;; (message "ICY Info \"%s\"" param)

                    (if (string-match "StreamTitle='\\([^;]*\\)';" param)

                        (setq media/current-song-in-stream
                              (let ((s (match-string 1 param)))
                                (concat (if (string= s "")
                                            "<no title>"
                                          (encode-coding-string s 'latin-1)
                                          ;; s
                                          )
                                        " | "
                                        (format-time-string "%a %b %d %H:%M:%S")
                                        )
                                )
                              )

                      ;; If we did not parse it properly, reset the
                      ;; song name, and display the ICY string raw
                      (setq media/current-song-in-stream nil)
                      (message "ICY Info \"%s\"" param)
                      )

                    (when media/mplayer/capture-dir
                      (let ((coding-system-for-write 'raw-text-unix))
                        (with-temp-buffer
                          (insert
                           (concat media/current-song-in-stream "\n"))
                          (write-region nil nil (concat media/mplayer/capture-dir "/log") t))))

                    (if (and media/current-song-in-stream media/current-information)
                        (media/show-current-information))
                    )

                   ;; ----------------------------------------

                   ("ANS_LENGTH"

                    (setq media/song-duration
                          (string-to-number (substring param 1))))

                   ;; ----------------------------------------

                   ("ANS_TIME_POSITION"

                    (setq media/song-current-time
                          (string-to-number (substring param 1)))

                    (when (and media/duration-to-history
                               (< media/mplayer/cumulated-duration media/duration-to-history))

                      (when media/mplayer/last-current-time
                        (setq media/mplayer/cumulated-duration
                              (+ media/mplayer/cumulated-duration
                                 (- media/song-current-time media/mplayer/last-current-time))))

                      (when (>= media/mplayer/cumulated-duration media/duration-to-history)
                        (media/put-in-history)
                        )

                      (setq media/mplayer/last-current-time media/song-current-time)
                      )
                    )

                   ;; ----------------------------------------

                   ("AUDIO:"

                    ;; param = "44100 Hz, 2 ch, s16le, 128.0 kbit/9.07% (ratio: 16000->176400)"
                    (when (string-match "^\\([0-9]+\\) Hz, \\([0-9]+\\) ch.* \\([0-9.]+\\) kbit"
                                        param)
                      (setq media/current-information
                            (list media/mplayer/url
                                  (string-to-number (match-string 1 param))
                                  (string-to-number (match-string 2 param))
                                  (string-to-number (match-string 3 param))))
                      )
                    (run-hooks 'media/play-hook)
                    )

                   ;; ----------------------------------------

                   ("Starting"
                    (media/mplayer/write "get_time_length\n")
                    (when media/mplayer/capture-dir
                      (media/mplayer/write "capturing\n")
                      ;; (message "Capturing stream in %s" media/mplayer/capture-dir)
                      )
                    )

                   ;; ----------------------------------------

                   ("Cache fill:"
                    (when (string-match "(\\([0-9]+\\) bytes" param)
                      (message "Caching stream (%dkb)"
                               (/ (string-to-number (match-string 1 param)) 1024))))

                   ;; ----------------------------------------

                   ("Exiting..."
                    (setq media/mplayer/exit-type
                          (cdr (assoc param '(("(End of file)" . file-finished)
                                              ("(Quit)" . quit))))
                          media/current-information nil
                          media/song-duration nil
                          media/song-current-time nil)

                    (when media/mplayer/process (kill-process media/mplayer/process))

                    (force-mode-line-update)
                    )

                   ;; ----------------------------------------

                   )
                 )
          )
         )
   )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun media/mplayer/filter (process str)
  (setq media/mplayer/buffer (concat media/mplayer/buffer str))
  (let ((start 0))
    (while (and (< start (length media/mplayer/buffer))
                (string-match "\\(.*\\)[\n
]+" media/mplayer/buffer start))
      (setq start (1+ (match-end 1)))
      (let ((line (match-string 1 media/mplayer/buffer)))
        (when (string-match media/mplayer/protocol-regexp line)
          (media/mplayer/filter-subfunctions (match-string 1 line) (match-string 2 line))))
      )
    (setq media/mplayer/buffer (substring media/mplayer/buffer start)))
  )

(defun media/mplayer/sentinel (process str) ()
  ;; (message "Media process got \"%s\"" (replace-regexp-in-string "\n" "" str))
  (unless (eq (process-status media/mplayer/process) 'run)
    (setq media/current-information nil
          media/mplayer/process nil
          media/song-current-time nil
          media/song-duration nil)

    (media/mplayer/stop-timing-requests)

    (if (eq media/mplayer/exit-type 'file-finished)
        (run-hooks 'media/finished-hook)
      (run-hooks 'media/error-hook))

    (force-mode-line-update))
  )

(defun media/mplayer/write (&rest l)
  ;;   (message "****** WROTE \"%s\"" (replace-regexp-in-string "\n" "[RETURN]" (apply 'format l)))
  (if media/mplayer/process (process-send-string media/mplayer/process (apply 'format l))
    (error "No mplayer process"))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Player control abstract layer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun media/api/init () "Called once when the media application starts"
  (setq media/player-id "MPlayer"
        media/mplayer/url nil
        media/mplayer/buffer "" ;; Used as read buffer
        media/mplayer/process nil
        media/mplayer/exit-type nil
        media/mplayer/paused nil
        media/song-duration nil
        media/song-current-time nil
        media/mplayer/cumulated-duration 0
        media/mplayer/last-current-time nil
        )
)

(defun media/api/cleanup () "Called when killing the application's buffer"
  (when media/mplayer/process
    (delete-process media/mplayer/process)
    (media/mplayer/stop-timing-requests)
    (setq media/mplayer/process nil)))

(defun media/api/play (url) (interactive)
  (setq media/mplayer/url url)

  (when media/mplayer/process (kill-process media/mplayer/process))

  ;; (if media/mplayer/process
  ;; (media/mplayer/write (concat "loadfile "
  ;; (replace-regexp-in-string "^file://" "" media/mplayer/url)
  ;; "\n"))

  (setq media/mplayer/process
        (apply
         'start-process
         (append
          `("mplayer" nil ,media/mplayer/executable "-slave" "-quiet")
          media/mplayer/args
          (when (string-match  "\\(asx\\|m3u\\|pls\\|ram\\)$" media/mplayer/url)
            (if media/mplayer/capture-dir
                (list "-dumpfile"
                      (concat media/mplayer/capture-dir
                              "/"
                              (replace-regexp-in-string "[^a-zA-Z0-9\.]" "_" media/mplayer/url)
                              (format-time-string "-%Y-%m-%d-%H:%M:%S"))
                      "-capture"
                      "-playlist"
                      )
              (list "-playlist"))
            )
          (list (replace-regexp-in-string "^file://" "" media/mplayer/url)))
         )
        media/mplayer/exit-type 'unknown
        media/mplayer/paused nil
        media/song-duration nil
        media/song-current-time nil
        media/mplayer/cumulated-duration 0
        media/mplayer/last-current-time nil
        )

  (set-process-filter media/mplayer/process 'media/mplayer/filter)
  (set-process-sentinel media/mplayer/process 'media/mplayer/sentinel)
  (process-kill-without-query media/mplayer/process)
  (media/mplayer/start-timing-requests)
  (media/mplayer/write "get_time_pos\n")
  )

(defun media/api/stop () (interactive)
  (media/mplayer/write "quit\n")
  )

(defun media/api/pause () (interactive)
  (media/mplayer/write "pause\n")
  (setq media/mplayer/paused (not media/mplayer/paused))
  )

(defun media/api/set-volume (mode value) (interactive)
  (if (eq mode 'absolute)
      (media/mplayer/write "volume %s 1\n" value)
    (if (>= value 0)
        (media/mplayer/write "volume +%s\n" value)
      (media/mplayer/write "volume %s\n" value))))

(defun media/api/jump-at-percent (percent) (interactive)
  (setq media/song-current-time nil)
  (when (< media/mplayer/cumulated-duration media/duration-to-history)
    (setq media/mplayer/cumulated-duration 0
          media/mplayer/last-current-time nil))
  (media/mplayer/write "seek %s 1\n" percent)
  (media/mplayer/write "get_time_pos\n")
  )

(defun media/api/jump-at-time (mode time) (interactive)
  (setq media/song-current-time nil)
  (when (< media/mplayer/cumulated-duration media/duration-to-history)
    (setq media/mplayer/cumulated-duration 0
          media/mplayer/last-current-time nil))
  (if (eq mode 'absolute)
      (media/mplayer/write "seek %s 2\n" time)
    (media/mplayer/write "seek %s 0\n" time))
  (media/mplayer/write "get_time_pos\n")
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;