[beirc-cvs] CVS beirc
rgoldman
rgoldman at common-lisp.net
Fri Apr 7 01:42:56 UTC 2006
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 , at other-args &allow-other-keys) , at 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*)))
More information about the Beirc-cvs
mailing list