[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SndStartFilePlay LONG
- To: info-mcl@digitool.com
- Subject: SndStartFilePlay LONG
- From: lynch@ils.nwu.edu (Richard Lynch)
- Date: 7 Apr 1995 06:50:07 GMT
- Organization: ILS
- Sender: owner-info-mcl@digitool.com
I'm having great difficulty getting SndStartFilePlay to work
asynchronously, and don't have a clue what is going wrong. Here's the
code. Hopefully, you've got an AIFF file around somewhere, or I can
e-mail you one.
If I ever get this working, it will go to the contrib.
----------------cut here-------------------------
;;;;SOUND
;;;;sound.lsp
;;;;MCMXCV Learning Sciences Corporation
;;;;Author: Richard Lynch
;;;;A view for playing sounds.
;;;;Revision History
;;;;
;;;;95/04/06 Created.
;(require "ll-init" #4P"ccl:Lynch Lib;ll-init")
;(require "t-or-nil")
(require "oou-init" #4P"ccl:oodles-of-utils;oou-init")
(oou-dependencies "+Files")
(defun error-message (datum &rest args)
(let* ((string (apply #'format nil datum args))
(string (concatenate 'string string " Please ask for assistance."))
)
(message-dialog string)
) )
(defclass sound-final-display (view)
( ( sound-path
:documentation "The path of the file to play."
:accessor sound-path
:initarg :sound-path
:initform nil
:type '(or null string pathname)
)
( sound-channel
:documentation "The sound channel pointer."
:accessor sound-channel
:initarg :sound-channel
:initform nil
:type t ;'(or macptr t-or-nil)
)
( frefnum
:documentation "The file reference number of the opened file."
:accessor frefnum
:initarg :frefnum
:initform 0
:type 'fixnum
)
)
(:default-initargs
:view-nick-name 'sound
) )
(defmethod sound-channel :around ((view sound-final-display))
(let ((channel (call-next-method)))
(if (sound-channel-valid-p view)
channel
(new-sound-channel view)
) ) )
(defmethod new-sound-channel ((view sound-final-display))
;;;It's probably hosed, and that's why we're doing this, but (close-sound-channel view)
(let ((err 0)
;(snd-ptr (#_NewPtr (record-length :sndChannel)))
(snd-ptr (%null-ptr))
)
(%stack-block ((ptr 4))
(%put-ptr ptr snd-ptr)
(setq err (#_SndNewChannel ptr 0 0 (%null-ptr)))
(case err
(0 (setf (sound-channel view) (%get-ptr ptr)))
(-204 (error-message "SndNewChannel returned -204, Problem loading
the resource."))
(-205 (error-message "SndNewChannel returned -205, Channel is
corrupt or unusable."))
(t (error-message "SndNewChannel returned ~A, an unknown error." err))
) ) ) )
(defmethod close-sound-channel ((view sound-final-display))
(let ((channel (slot-value view 'sound-channel))
(err 0)
)
(if (macptrp channel)
(case (setq err (#_SndDisposeChannel channel t))
(0 (setf (sound-channel view) nil))
(-205 (error-message "SndDisposeChannel returned -205, Channel is
corrupt or unusable."))
(t (error-message "SndDisposeChannel returned ~A, an unknown
error." err))
)
;(error-message "The sound channel wasn't even a macptr in
close-sound-channel.")
) ) )
(defmethod sound-channel-valid-p ((view sound-final-display))
(let ((channel (slot-value view 'sound-channel))
(err 0)
)
(when (macptrp channel)
;;;Does the null command even check the channel in any material way?
;;;I seem to remember it doesn't.
;;;Maybe I should a series of gets on the data structure to really check (rlet ((cmd :sndCommand :cmd #$nullCmd))
(setq err (#_SndDoImmediate channel cmd))
(zerop err)
) ) ) )
(defmethod volume ((view sound-final-display))
(let ((channel (sound-channel view))
(err 0)
)
(if (macptrp channel)
(rlet ((cmd :sndCommand :cmd #$getAmpCmd))
(case (setq err (#_SndDoImmediate channel cmd))
(0 (rref cmd :sndCommand.param1))
(-205 (error-message "SndDoImmediate in volume returned -205,
Channel is corrupt or unusable."))
(t (error-message "SndDoImmediate in volume returned ~A, an
unknown error." err))
) )
(progn
(error-message "The sound channel wasn't even a macptr in volume.")
-1
) ) ) )
(defmethod (setf volume) (new-value (view sound-final-display))
(let ((channel (sound-channel view))
(err 0)
)
(if (macptrp channel)
(rlet ((cmd :sndCommand :cmd #$ampCmd :param1 new-value))
(case (setq err (#_SndDoImmediate channel cmd))
(0 new-value)
(-205 (error-message "SndDoImmediate in set-volume returned
-205, Channel is corrupt or unusable."))
(t (error-message "SndDoImmediate in set-volume returned ~A, an
unknown error." err))
) )
(progn
(error-message "The sound channel wasn't even a macptr in set-volume.")
-1
) ) ) )
(defmethod set-volume ((view sound-final-display) new-value)
(setf (volume view) new-value)
)
(defmethod sound-busy-p ((view sound-final-display))
(let ((channel (sound-channel view)))
(if (macptrp channel)
(let ((err 0)
(len #.(record-length :SCStatus))
)
(rlet ((SCStatus :SCStatus))
(case (setq err (#_SndChannelStatus channel len SCStatus))
(0 (pref SCStatus :SCStatus.scChannelBusy))
(-50 (error-message "SndChannelStatus in sound-busy-p returned
-50, incorrect parameter."))
(-205 (error-message "SndChannelStatus in sound-busy-p
returned -205, Channel is corrupt or unusable."))
(t (error-message "SndChannelStatus in sound-busy-p returned
~A, an unknown error." err))
) ) )
(progn
(error-message "The sound channel wasn't even a macptr in
sound-busy-p.")
nil
) ) ) )
(defmethod start-time ((view sound-final-display))
"Returns the start-time of the sound file being played."
(let ((channel (sound-channel view)))
(if (macptrp channel)
(let ((err 0)
(len #.(record-length :SCStatus))
)
(rlet ((SCStatus :SCStatus))
(case (setq err (#_SndChannelStatus channel len SCStatus))
(0 (pref SCStatus :SCStatus.scStartTime))
(-50 (error-message "SndChannelStatus in start-time returned
-50, incorrect parameter."))
(-205 (error-message "SndChannelStatus in start-time returned
-205, Channel is corrupt or unusable."))
(t (error-message "SndChannelStatus in start-time returned ~A,
an unknown error." err))
) ) )
(progn
(error-message "The sound channel wasn't even a macptr in start-time.")
nil
) ) ) )
(defmethod current-time ((view sound-final-display))
"Returns the current-time location of the sound file being played."
(let ((channel (sound-channel view)))
(if (macptrp channel)
(let ((err 0)
(len #.(record-length :SCStatus))
)
(rlet ((SCStatus :SCStatus))
(case (setq err (#_SndChannelStatus channel len SCStatus))
(0 (pref SCStatus :SCStatus.scCurrentTime))
(-50 (error-message "SndChannelStatus in current-time returned
-50, incorrect parameter."))
(-205 (error-message "SndChannelStatus in current-time
returned -205, Channel is corrupt or unusable."))
(t (error-message "SndChannelStatus in current-time returned
~A, an unknown error." err))
) ) )
(progn
(error-message "The sound channel wasn't even a macptr in
current-time.")
nil
) ) ) )
(defmethod end-time ((view sound-final-display))
"Returns the end-time location of the sound file being played."
(let ((channel (sound-channel view)))
(if (macptrp channel)
(let ((err 0)
(len #.(record-length :SCStatus))
)
(rlet ((SCStatus :SCStatus))
(case (setq err (#_SndChannelStatus channel len SCStatus))
(0 (pref SCStatus :SCStatus.scEndTime))
(-50 (error-message "SndChannelStatus in end-time returned
-50, incorrect parameter."))
(-205 (error-message "SndChannelStatus in end-time returned
-205, Channel is corrupt or unusable."))
(t (error-message "SndChannelStatus in end-time returned ~A,
an unknown error." err))
) ) )
(progn
(error-message "The sound channel wasn't even a macptr in end-time.")
nil
) ) ) )
;;;;Since sndStartFilePlay needs a fRefNum, and the only trap I can find that
;;;;returns such a thing is FSpOpenDF, which opens the file, I'm assuming they
;;;;want me to open the file and leave it open until the sound is done playing;;;;I guess. <frown> Sometimes the most basic things are left out of docs.
;;;;<sigh>
(defmethod play ((view sound-final-display))
(let* ((path (sound-path view))
(path (mac-namestring path))
(channel (sound-channel view))
(err 0)
)
(rlet ((fsSpec :fsSpec))
(with-pstrs ((fileName path))
(case (setq err (#_FSMakeFSSpec 0 0 fileName fsSpec))
( 0
(rlet ((refnum :integer))
;;;Let's stuff a zero in there so we're sure that FSpOpenDF did
;;;*something* when we check it.
(%put-word refnum 0)
(case (setq err (setq err (#_FSpOpenDF fsSpec #$fsRdPerm refnum)))
( 0
(format t "fRefNum ~A~%"
(setf (frefnum view) (%get-word refnum))
)
(if (sound-channel-valid-p view)
(let ((frefnum (frefnum view))
(resNum 0)
;;;0 is supposed to allocate one the default size
;;;but that kept saying too small a buffer.
;;;Toolbox assistant said 20480 for slower macs,
;;;but that also kept saying too small.
;;;So, I upped it.
(bufferSize 2048000)
(theBuffer (%null-ptr))
(theSelection (%null-ptr))
(theCompletion (%null-ptr))
(async #$true)
)
(case (setq err (#_SndStartFilePlay channel frefnum
resNum bufferSize theBuffer theSelection theCompletion async))
(0)
(-201 (error-message "SndStartFilePlay in play
returned -201, insufficient hardware."))
(-203 (error-message "SndStartFilePlay in play
returned -203, no room in the queue."))
(-205 (error-message "SndStartFilePlay in play
returned -205, channel corrupt or unusable."))
(-206 (error-message "SndStartFilePlay in play
returned -206, resource is corrupt or unusable."))
(-207 (error-message "SndStartFilePlay in play
returned -207, insufficient memory is available."))
(-208 (error-message "SndStartFilePlay in play
returned -208, file is corrupt or unusable, or not AIFF or AIFF-C."))
(-209 (error-message "SndStartFilePlay in play
returned -209, channel is busy."))
(-210 (error-message "SndStartFilePlay in play
returned -210, buffer is too small."))
(-223 (error-message "SndStartFilePlay in play
returned -223, invalid compression type."))
(t (error-message "SndStartFilePlay in play
returned ~A, an unknown error." err))
)
(unless (zerop err)
;I'm not even gonna ask why MCL left out FSClose!
(case (setq err (#~FSClose (frefnum view)))
(0 (setf (frefnum view) 0))
(-36 (error-message "FSClose in play returned
-36, I/O error."))
(-38 (error-message "FSClose in play returned
-38, File not open."))
(-43 (error-message "FSClose in play returned
-43, File not found."))
(-51 (error-message "FSClose in play returned
-51, bad reference number."))
(t (error-message "FSClose in play returned ~A,
an unkown error." err))
) ) )
(error-message "Invalid sound channel in play.")
) )
(-35 (error-message "FSpOpenDf in play returned -35, no
such volume."))
(-36 (error-message "FSpOpenDf in play returned -36, I/O
error."))
(-37 (error-message "FSpOpenDf in play returned -37, bad
filename."))
(-42 (error-message "FSpOpenDf in play returned -42, too
many files open."))
(-43 (error-message "FSpOpenDf in play returned -43, file
not found."))
(-49 (error-message "FSpOpenDf in play returned -49, file
already open for writing."))
(-54 (error-message "FSpOpenDf in play returned -54,
attempt to open locked file for writing."))
(-120 (error-message "FSpOpenDf in play returned -120,
folder not found or incomplete pathname."))
(-5000 (error-message "FSpOpenDf in play returned -5000,
access denied."))
(t (error-message "FSpOpenDf in play returned ~A, an
unknown error message." err))
) ) )
(-35 (error-message "FSMakeFSSpec in play returned -35, volume
doesn't exist."))
(-43 (error-message "FSMakeFSSpec in play returned -43, file
doesn't exist."))
(t (error-message "FSMakeFSSpec in play returned ~A, an unknown
error message." err))
) ) ) ) )
#|
(defparameter sound
(make-instance 'sound-final-display
:sound-path (choose-file-dialog)
) )
(new-sound-channel sound)
(sound-channel sound)
;;;All the following seem happy with the channel(sound-channel-valid-p sound)
(sound-busy-p sound)
(start-time sound)
(current-time sound)
(end-time sound)
(trace sound-channel-valid-p)
;;;except for this guy, which sez the channel's corrupt:
(play sound)
;;;and these guys <frown>
;(setf (volume sound) 5)
;(volume sound)
;once, volume return -15845, and setf volume crashed the machine w/ error 3.
;twice volume hung the machine
;once setf volume actually returned 5 <smile> and then volume hung
(close-sound-channel sound)
|#
--
--
--
-- "TANSTAAFL" Rich lynch@ils.nwu.edu