Re: [MD:4204] Sound support

[MIYASHITA Hisashi(宮下 尚:HIMI) <himi@xxxxxxxxxxx>]

At Wed, 26 Feb 2003 07:46:15 +0900,
MIYOSHI Masanori wrote:

> MCI の primitive function を commit しました。

ぷっ...。なんという素早さ。

敬意を表しまして、30分ぐらいで、以下のようなものをでっち上げました。^^;;;
キーバインドを適当に決めたら、結構使えるぞ。これ。

## 圭一さん病に私も罹患した模様... ^^;;;

from himi
--------------------------------------------------------------------------------
;; mw32cdplay

(require 'timer)

(defconst mw32-cdplayer-device-name "mw32cdplay")
(defconst mw32-cdplayer-buffer-name "*cdplayer*")
(defconst mw32-cdplayer-refresh-time 0.3)

;; [<status> <time> <track> <tot. time> <num. of tracks>]
(defvar mw32-cdplayer-current-status
  (make-vector 5 nil))
(defvar mw32-cdplayer-buffer nil)
(defvar mw32-cdplayer-timer nil)
(defsubst mw32-cdplayer-current-status ()
  (aref mw32-cdplayer-current-status 0))
(defsubst mw32-cdplayer-current-time ()
  (aref mw32-cdplayer-current-status 1))
(defsubst mw32-cdplayer-current-track ()
  (aref mw32-cdplayer-current-status 2))
(defsubst mw32-cdplayer-total-time ()
  (aref mw32-cdplayer-current-status 3))
(defsubst mw32-cdplayer-number-of-tracks ()
  (aref mw32-cdplayer-current-status 4))

(defun mw32-cdplayer-send (cmd &optional arg)
  (let ((result
	 (mw32-mci-send-string
	  (format "%s %s %s" cmd mw32-cdplayer-device-name (or arg "")))))
    (if (numberp result)
	(progn
	  (mw32-cdplayer-uninit)
	  (error "MCI error!:%d" result)))
    result))

(defun mw32-cdplayer-update-status ()
  (aset mw32-cdplayer-current-status 0
	(mw32-cdplayer-send "status" "mode"))
  (aset mw32-cdplayer-current-status 1
	(mw32-cdplayer-send "status" "position"))
  (aset mw32-cdplayer-current-status 2
	(mw32-cdplayer-send "status" "current track"))
  (aset mw32-cdplayer-current-status 3
	(mw32-cdplayer-send "status" "length"))
  (aset mw32-cdplayer-current-status 4
	(mw32-cdplayer-send "status" "number of tracks")))

(defun mw32-cdplayer-get-position (trk)
  (mw32-cdplayer-send "status" (format "position track %s" trk)))

(defsubst mw32-cdplayer-format-time (time)
  (if (string-match "\\([0-9]+\\):\\([0-9]+\\):[0-9]+" time)
      (concat (match-string 1 time) ":" (match-string 2 time))
    time))

(defun mw32-show-status (buf)
  (save-excursion
    (set-buffer buf)
    (erase-buffer)
    (insert "Meadow simple CD Player\n")
    (insert (format "   Tracks %s/%s\n"
		    (mw32-cdplayer-current-track)
		    (mw32-cdplayer-number-of-tracks)))
    (insert (format "   Time %s/%s\n"
		    (mw32-cdplayer-format-time
		     (mw32-cdplayer-current-time))
		    (mw32-cdplayer-format-time
		     (mw32-cdplayer-total-time))))))

(defun mw32-cdplayer-init ()
  (let ((st (mw32-mci-send-string
	     (format "open cdaudio alias %s"
		     mw32-cdplayer-device-name))))
    (if (numberp st)
	(if (= st 291)
	    (error "Other device may open CD device!")
	  (if (/= st 289)
	      (error "MCI error:%d" st))))
    (mw32-cdplayer-update-status)
    (if (not (bufferp mw32-cdplayer-buffer))
	(setq mw32-cdplayer-buffer
	      (get-buffer-create mw32-cdplayer-buffer-name)))
    (mw32-show-status
     mw32-cdplayer-buffer)
    (if (null mw32-cdplayer-timer)
	(setq mw32-cdplayer-timer
	      (timer-create)))
    (timer-set-function
     mw32-cdplayer-timer
     (function mw32-cdplayer-timer-handler))
    (timer-set-time mw32-cdplayer-timer
		    (current-time)
		    mw32-cdplayer-refresh-time)
    (timer-activate mw32-cdplayer-timer)))

(defun mw32-cdplayer-timer-handler ()
  (if (bufferp mw32-cdplayer-buffer)
      (progn
	(mw32-cdplayer-update-status)
	(mw32-show-status
	 mw32-cdplayer-buffer))))

(defun mw32-cdplayer-uninit
  (mw32-cdplayer-send "close")
  (if mw32-cdplayer-timer
      (cancel-timer mw32-cdplayer-timer)))

(defun mw32-cdplayer-play (&optional start end)
  (interactive)
  (let ((arg ""))
    (if start (setq arg (format "from %s" start)))
    (if end (setq arg (format "%s to %s" arg end)))
    (mw32-cdplayer-send "play" arg)))

(defun mw32-cdplayer-stop ()
  (interactive)
  (mw32-cdplayer-send "stop"))

(defun mw32-cdplayer-pause ()
  (interactive)
  (mw32-cdplayer-send "pause"))

(defun mw32-cdplayer-next-track ()
  (mw32-cdplayer-update-status)
  (let ((trk
	 (string-to-number
	  (mw32-cdplayer-current-track)))
	pos)
    (setq pos (mw32-cdplayer-get-position
	       (1+ trk)))
    (mw32-cdplayer-play pos)))

(defun mw32-cdplayer-previous-track ()
  (mw32-cdplayer-update-status)
  (let ((trk
	 (string-to-number
	  (mw32-cdplayer-current-track)))
	pos)
    (setq pos (mw32-cdplayer-get-position
	       (max 1 (1- trk))))
    (mw32-cdplayer-play pos)))

(defun mw32-cdplayer ()
  (interactive)
  (mw32-cdplayer-init))

(provide 'mw32cdplay)