timidity.el

linux上播放midi音乐,但是要一些设置.可网上查找. 软件名称: TiMidity++-2.13.0.tar

(defun timidity-PAN (ch val)
  (set-buffer timidity-main-buffer)
  (let ((buffer-read-only nil))
    (goto-char (+ timidity-note-table-ofs
		  (* ch 80)
		  65))
    (delete-char 3)
    (cond ((= val -1)		(insert "   "))
	  ((< val 5)		(insert " L "))
	  ((> val 123)		(insert " R "))
	  ((and (> val 60) (< val 68)) (insert " C "))
	  (t
	   (setq val (/ (* 100 (- val 64)) 64))
	   (if (>= val 0)
	       (insert ?+)
	     (insert ?-)
	     (setq val (- val)))
	   (insert (format "%02d" val))))))

(defun timidity-SUS (ch val)
  (set-buffer timidity-main-buffer)
  (let ((buffer-read-only nil))
    (goto-char (+ timidity-note-table-ofs
		  (* ch 80)
		  69))
    (delete-char 1)
    (insert (if (zerop val) ?\  ?S))))

(defun timidity-PIT (ch val)
  (set-buffer timidity-main-buffer)
  (let ((buffer-read-only nil))
    (goto-char (+ timidity-note-table-ofs
		  (* ch 80)
		  71))
    (delete-char 1)
    (insert (cond ((= val -1) ?=)
		  ((> val 8192) ?>)
		  ((< val 8192) ?<)
		  (t ?\  )))))

(defun timidity-RESET ()
  (set-buffer timidity-main-buffer)
  (let ((buffer-read-only nil)
	i s s1)
    (sit-for 0) ; flush
    (erase-buffer)
    (if timidity-reset-bufstr
	(insert timidity-reset-bufstr)
      (insert ?\n)
      (insert "  |>                                               |            \n")
      (insert "Ch c d ef g a bc d ef g a bc d ef g a bc d ef g a b  Prg Vol Exp Pan S B\n")
      (setq s (make-string 48 ?.))
      (setq s1 (make-string 28 ?\ ))
      (setq i 0)
      (while (< i 16)
	(insert (format "%02d " (1+ i)) s s1 ?\n)
	(setq i (1+ i)))
      (setq timidity-reset-bufstr (buffer-string)))
    (setq timidity-current-time-bar 0)
    (goto-char (point-min))
    (insert "File: " timidity-current-filename)
    (forward-line 3)
    (setq timidity-note-table-ofs (point))
    (setq i 0)
    (while (< i 16)
      (if (timidity-is-drumchannel i)
	  (progn
	    (forward-char 2)
	    (delete-char 1)
	    (insert ?*)))
      (setq i (1+ i))
      (forward-line 1))))

(defun timidity-load-file (fname)
  (interactive "FMIDI file: ")
  (if fname
      (progn
	(setq timidity-playing-flag t)
	(timidity-run)
	(setq fname (timidity-expand-file-name fname))
	(garbage-collect)
	(process-send-string timidity-cmd-process
			     (format "L\nPLAY %s\n" fname))
	(message "MIDI File: %s" fname))
    (setq timidity-playing-flag nil)))

(defun timidity-load-file-list ()
  (interactive)
  (let ((f (concat (expand-file-name "") "/"))
	files)
    (while (not (string= "" (setq f (read-file-name
				     "MIDI File: "
				     (file-name-directory
				      (timidity-expand-file-name f))
				     ""))))
      (setq files (cons (timidity-expand-file-name f) files)))
    (setq timidity-next-files (append (reverse files) timidity-next-files))
    (timidity-next-file)))

(defun timidity-next-file ()
  (interactive)
  (if timidity-next-files
      (let ((f (car timidity-next-files)))
	(setq timidity-next-files (cdr timidity-next-files))
	(setq timidity-prev-files (cons f timidity-prev-files))
	(timidity-load-file f))))

(defun timidity-prev-file ()
  (interactive)
  (if timidity-playing-flag
      (if (cdr timidity-prev-files)
	  (let ((f (car timidity-prev-files)))
	    (setq timidity-prev-files (cdr timidity-prev-files))
	    (setq timidity-next-files (cons f timidity-next-files))
	    (timidity-load-file (car timidity-prev-files)))
	(timidity-load-file (car-safe timidity-prev-files)))
    (timidity-load-file (car-safe timidity-prev-files))))

(defun timidity-replay-cmd ()
  (interactive)
  (if timidity-playing-flag
      (timidity-simple-cmd 1 ?r)
    (timidity-load-file (car-safe timidity-prev-files))))

(defun timidity-quit ()
  (interactive)
  (if (and timidity-cmd-process
	   (or (null (buffer-name (process-buffer timidity-cmd-process)))
	       (eq 'exit (process-status timidity-cmd-process))))
      (setq timidity-cmd-process nil))
  (if timidity-cmd-process
      (progn
	(process-send-string timidity-cmd-process (format "QUIT\n"))
	(setq timidity-cmd-process nil)))
  (if timidity-orig-window-configuration
      (progn
	(set-window-configuration timidity-orig-window-configuration)
	(setq timidity-orig-window-configuration nil))))

(defun timidity-simple-cmd (&optional cnt cmd)
  (interactive "p")
  (process-send-string timidity-cmd-process
		       (format "%c%d\n"
			       (if cmd cmd last-command-char)
			       (if cnt cnt 1))))

(defun timidity-select-drumchannel (ch)
  (interactive "nChannel: ")
  (if (or (not (integerp ch))
	  (< ch 1)
	  (> ch 16))
      (error "Invalid channel: %s" ch))
  (process-send-string timidity-cmd-process (format "d%d\n" (1- ch))))

(defun timidity-is-drumchannel (ch)
  (not (zerop (logand timidity-drumchannels (lsh 1 ch)))))

(defun timidity-update-time-bar (bar)
  (let (diff)
    (setq diff (- bar timidity-current-time-bar))
    (goto-char (point-min))
    (forward-line 1)
    (forward-char 3)
    (if (< 0 diff)
	(progn
	  (insert-char ?= diff)
	  (skip-chars-forward "=")
	  (if (= 48 bar)
	      (delete-char diff)
	    (forward-char 1)
	    (delete-char diff)))
      (setq diff (- diff))
      (delete-char diff)
      (skip-chars-forward "=")
      (if (eq (following-char) ?|)
	  (progn
	    (insert-char ?> 1)
	    (setq diff (1- diff))))
      (forward-char 1)
      (insert-char ?\  diff))))

(defun timidity-expand-file-name (fname)
  (if (or (string-match "^http://" fname)
	  (string-match "^ftp://" fname)
	  (string-match "^file://" fname)
	  (string-match "^news://" fname)
	  (string-match "^mime:" fname))
      fname
    (expand-file-name fname)))

(or (fboundp 'member)
    (defun member (elt lis)
      "A member function for emacs 18."
      (let ((loop t))
	(while (and loop lis)
	  (if (equal elt (car lis))
	      (setq loop nil)
	    (setq lis (cdr lis))))
	lis)))

(defvar timidity-demo-string
'("#######   ###   #     #   ###   ######    ###   ####### #     #"
  "   #       #    ##   ##    #    #     #    #       #     #   # "
  "   #       #    # # # #    #    #     #    #       #      # #  "
  "   #       #    #  #  #    #    #     #    #       #       #   "
  "   #       #    #     #    #    #     #    #       #       #   "
  "   #       #    #     #    #    #     #    #       #       #   "
  "   #      ###   #     #   ###   ######    ###      #       #   "
  "              TiMidity emacs interface written by Masanao Izumo"
  "                                                               "
  "   l/L: Load & Play a MIDI file                                "
  "   n/p: Next/Prev file                                         "
  "   r  : Replay a MIDI file                                     "
  "   q: Quit                                                     "
))

(defun timidity-demo ()
  (interactive)
  (set-buffer timidity-main-buffer)
  (let ((buffer-read-only nil)
	(win-width  (- (window-width) 3))
	(win-height (window-height))
	(str-width  (length (car timidity-demo-string)))
	(str-height (length timidity-demo-string))
	start-point i j k evenp sline c)
    (erase-buffer)
    (if (<= win-height str-height)
	(setq win-height str-height))
    (if (<= win-width str-width)
	(setq win-width str-width))
    (insert-char ?\n win-width)
    (goto-line (/ (- win-height str-height) 2))

    (if (= (% (- win-width str-width) 2) 1)
	(setq win-width (1- win-width)))

    (setq start-point (point)
	  i 0
	  evenp nil)
    (while (< i str-height)
      (if evenp (insert-char ?\  win-width))
      (forward-line 1)
      (setq evenp (not evenp)
	    i (1+ i)))

    (setq j 0)
    (while (< j str-width)
      (goto-char start-point)
      (setq evenp nil
	    i 0
	    sline timidity-demo-string)
      (while (< i str-height)
	(if evenp
	    (progn
	      (delete-char 1)
	      (end-of-line)
	      (insert-char (aref (car sline) j) 1))
	  (insert-char (aref (car sline) (- str-width j 1)) 1))
	(setq i (1+ i)
	      evenp (not evenp)
	      sline (cdr sline))
	(forward-line 1))
      (setq j (1+ j))
      (sit-for 0.01))
    (setq j 0
	  k (/ (- win-width str-width) 2))
    (while (< j k)
      (goto-char start-point)
      (setq evenp nil
	    i 0
	    sline timidity-demo-string)
      (while (< i str-height)
	(if evenp
	    (delete-char 1)
	  (insert-char ?\  1))
	(setq i (1+ i)
	      evenp (not evenp)
	      sline (cdr sline))
	(forward-line 1))
      (setq j (1+ j))
      (sit-for 0.01))))

(mapcar (function (lambda (symbol)
		    (if (byte-code-function-p (symbol-function symbol))
			nil
		      (message "Byte compiling %s..." symbol)
		      (byte-compile symbol))))
	timidity-pre-byte-compiles)

(provide 'timidity)