Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2727
Modified Files: application.lisp beirc.asd post-message-hooks.lisp variables.lisp Added Files: sound-player.lisp Log Message: Revised treatment of sounds.
--- /project/beirc/cvsroot/beirc/application.lisp 2006/04/04 18:37:28 1.74 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/07 01:42:56 1.75 @@ -104,6 +104,10 @@ (beirc-app-display frame pane (server-receiver *application-frame*))) :display-time nil :width 400 :height 600 + ;; added this, in the hopes that overwriting the :height argument + ;; would allow more freedom to resize the tab-pane + ;; (query). [2006/04/05:rpg] + :min-height 100 :incremental-redisplay t))) (:geometry :width 800 :height 600) (:top-level (clim:default-frame-top-level :prompt 'beirc-prompt)) @@ -311,6 +315,8 @@ (when (processes-supported-p) (clim-sys:destroy-process ticker-process)) (disconnect-all frame "Client Quit")))))) + ;; will start up a sound player, if you've configured one. [2006/04/06:rpg] + (start-sound-server) (cond (new-process (setf *gui-process* @@ -1047,3 +1053,6 @@ `(com-connect ,server))))
+(defmethod frame-exit :after ((frame beirc)) + "Shut off the sound server process, if necessary." + (stop-sound-server)) \ No newline at end of file --- /project/beirc/cvsroot/beirc/beirc.asd 2006/03/27 21:42:41 1.9 +++ /project/beirc/cvsroot/beirc/beirc.asd 2006/04/07 01:42:56 1.10 @@ -6,7 +6,7 @@ (cl:in-package :beirc.system)
(defsystem :beirc - :depends-on (:mcclim :cl-irc :split-sequence :tab-layout :cl-ppcre) + :depends-on (:mcclim :cl-irc :split-sequence :tab-layout :cl-ppcre :cl-fad) :components ((:file "package") (:file "variables" :depends-on ("package")) (:file "events" :depends-on ("package")) @@ -16,4 +16,8 @@ (:file "application" :depends-on ("package" "variables" "presentations" "events" "receivers")) (:file "message-processing" :depends-on ("package" "variables" "receivers" "application")) (:file "post-message-hooks" :depends-on ("package")) + ;; we use the post-message-hook definer here. This is + ;; probably wrong, and the dependency should be + ;; removed. [2006/04/06:rpg] + (:file "sound-player" :depends-on ("post-message-hooks")) )) \ No newline at end of file --- /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/03/24 21:19:44 1.1 +++ /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/04/07 01:42:56 1.2 @@ -15,17 +15,3 @@ `(progn (defun ,hook-name (,message-var ,frame-var ,receiver-var ,@other-args &allow-other-keys) ,@body) (setf (gethash ',hook-name *post-message-hooks*) ',hook-name)))
-;;;--------------------------------------------------------------------------- -;;; If you set *default-sound-player* and *sound-for-my-nick* this -;;; should work... It leaves a lot to be desired. This should -;;; probably turn into some kind of general noisemaking interface... -;;; But this should get us thinking. [2006/03/24:rpg] -;;;--------------------------------------------------------------------------- -(define-post-message-hook noisemaker (msg frame receiver &key message-directed-to-me) - (declare (ignore msg frame receiver)) - (when (and message-directed-to-me - *default-sound-player* - *sound-for-my-nick*) - #+allegro - (excl:run-shell-command (format nil "~A ~A" *default-sound-player* *sound-for-my-nick*) - :error-output "/dev/null" :if-error-output-exists :append :wait t))) --- /project/beirc/cvsroot/beirc/variables.lisp 2006/03/27 21:42:41 1.14 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/04/07 01:42:56 1.15 @@ -9,8 +9,12 @@ #+linux "/usr/bin/x-www-browser") (defvar *default-sound-player* (or nil - #+linux "/usr/bin/ogg123") - "An external program that can be used to produce sounds.") + #+linux "/usr/bin/ogg123 -") + "An external program that can be used to produce sounds. +You should set this to be a program that will read from +its standard input and produce sounds. See the example +value, which is ogg123, configured to read its input from +stdin, instead of from a file.") (defvar *sound-for-my-nick* nil "If the NOISEMAKER post-message-hook is enabled, and there is a *default-sound-player* defined, this noise will be
--- /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/07 01:42:56 NONE +++ /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/07 01:42:56 1.1 (in-package :beirc)
;;;--------------------------------------------------------------------------- ;;; This is a rudimentary approach to having a permanently-running ;;; sound server to which you can dump sounds. [2006/04/06:rpg] ;;;---------------------------------------------------------------------------
;;;--------------------------------------------------------------------------- ;;; To dos: ;;; 1. figure out whether this is at all compatible with a ;;; single-threaded lisp, and if so, how to make it work out. ;;; 2. Add cmucl and sbcl sound player forms. SBCL added; needs to be checked. ;;;---------------------------------------------------------------------------
(defvar *sound-server-pid* NIL "What's the PID of the process to which you can dump sounds? Should probably be moved to a slot of the application.")
(defvar *sound-server-stream* NIL "What's the stream into which you dump sound files?")
(defun start-sound-server (&optional (sound-player-cmd *default-sound-player*)) (when sound-player-cmd (let (sound-stream pid) #+allegro (let (bogon) (multiple-value-setq (sound-stream bogon pid) (excl:run-shell-command sound-player-cmd :wait nil :input :stream :output "/dev/null" :if-output-exists :append :error-output "/dev/null" :if-error-output-exists :append))) ;; the following is close to completely untested... [2006/04/06:rpg] #+sbcl (let ((p (sb-ext:run-program "/bin/sh" (list "-c" sound-player-cmd) :input :stream :output nil :error nil))) (setf sound-stream (process-input p) pid (process-pid p))) #-(or allegro sbcl) (progn (cerror "Just reset *default-sound-player* to NIL and run without sounds." "Don't know how to start a beirc sound server for this lisp. Feel free to supply one.") (setf *default-sound-player* nil) (return-from start-sound-server nil)) (declare (ignore bogon)) (setf *sound-server-pid* pid *sound-server-stream* sound-stream)) ))
(defun stop-sound-server () "As the name suggests, shut down the sound server, killing the OS subprocess." (when *sound-server-pid* #+sbcl (sb-posix:kill *sound-server-pid* sb-posix:sigkill) #+allegro (progn (close *sound-server-stream*) (system:reap-os-subprocess :pid *sound-server-pid*)) (setf *sound-server-pid* nil *sound-server-stream* nil)) (values)) (defun play-sound-file (filename &optional (stream *sound-server-stream*)) "Play a sound file by dumping it into a stream opened by a sound server program." (copy-to-stream filename stream))
;;;--------------------------------------------------------------------------- ;;; Helper function ;;;---------------------------------------------------------------------------
(defun copy-to-stream (from-file to-stream) "Dump the contents of the file FROM-FILE into the stream TO-STREAM." (with-open-file (from from-file) (cl-fad:copy-stream from to-stream)))
;;;--------------------------------------------------------------------------- ;;; If you set *default-sound-player* and *sound-for-my-nick* this ;;; should work... It leaves a lot to be desired. This should ;;; probably turn into some kind of general noisemaking interface... ;;; But this should get us thinking. [2006/03/24:rpg] ;;;--------------------------------------------------------------------------- (define-post-message-hook noisemaker (msg frame receiver &key message-directed-to-me) (declare (ignore msg frame receiver)) (when (and message-directed-to-me *sound-server-stream* *sound-for-my-nick*) (play-sound-file *sound-for-my-nick* *sound-server-stream*)))