home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #1 / NN_1993_1.iso / spool / comp / lang / lisp / 3201 < prev    next >
Encoding:
Text File  |  1993-01-07  |  6.5 KB  |  178 lines
  1. Path: sparky!uunet!zaphod.mps.ohio-state.edu!uwm.edu!ogicse!das-news.harvard.edu!cantaloupe.srv.cs.cmu.edu!crabapple.srv.cs.cmu.edu!mkant
  2. From: mkant+@cs.cmu.edu (Mark Kantrowitz)
  3. Newsgroups: comp.lang.lisp
  4. Subject: Re: Playing sparcaudio directly from lisp
  5. Keywords: Lucid sparcaudio
  6. Message-ID: <C0IEG8.G5n.1@cs.cmu.edu>
  7. Date: 8 Jan 93 00:24:04 GMT
  8. Article-I.D.: cs.C0IEG8.G5n.1
  9. References: <1993Jan7.210217.21559@cs.cornell.edu>
  10. Sender: news@cs.cmu.edu (Usenet News System)
  11. Organization: School of Computer Science, Carnegie Mellon
  12. Lines: 163
  13. Nntp-Posting-Host: glinda.oz.cs.cmu.edu
  14.  
  15. In article <1993Jan7.210217.21559@cs.cornell.edu> raman@cs.cornell.edu (T. V. Raman) writes:
  16. >I plan to start using sparc audio extensively inside a clos program,
  17. >(playing sound files)  and at present I am just calling the shell and
  18. >invoking the play program.
  19. >
  20. >As I am also using the multitasking environment, (the playing of a
  21. >sound is a process)
  22. >things do slow down my clos application.
  23. >
  24. >How much of a performance benefit will I get if I rewrite play in
  25. >lucid directly? I will avoid the overhead of starting a shell each
  26. >time,  but will this be offset by the fact that I will be reading the
  27. >data and writing it out to /dev/audio in lisp?
  28. >
  29. >Finally if it would be worthwhile to write such a thing, how would one
  30. >write an efficient version in lisp?  I have never done buffered I/O in
  31. >lisp, and the play program written in C uses  buffered reads and
  32. >writes for efficiency.
  33.  
  34. I wrote the following code for Allegro CL. As you can see by
  35. experimentation with the code and variations on it, playing the sound
  36. files from Lisp is much too slow. Lisp file IO just isn't fast enough.
  37. If you're going to play sound files, you'll have to do much of the
  38. work in C, and then use a foreign function interface to run the code. 
  39.  
  40. Interestingly enough, using "cat ~a > ~a &" instead of "cat ~a > ~a"
  41. in the run-shell-command causes the sparc to occasionally crash due to
  42. a Mach bug. I don't know whether they've fixed the bug. (The problem does
  43. not occur under SunOS.)
  44.  
  45.  
  46. --mark
  47.  
  48. ;;; ****************************************************************
  49. ;;; output-sounds.lisp *********************************************
  50. ;;; ****************************************************************
  51. ;;; Mon Aug 17 21:50:37 1992 by Mark Kantrowitz <mkant@GLINDA.OZ.CS.CMU.EDU>
  52. ;;; output-sounds.lisp -- 4574 bytes
  53.  
  54. ;;; Outputs sounds files under Allegro on SPARCs.
  55.  
  56. ;;; ********************************
  57. ;;; read-audio-filehdr *************
  58. ;;; ********************************
  59.  
  60. (defun read-ascii-string (file-stream num-bytes)
  61.   (let ((result (make-string num-bytes)))
  62.     (dotimes (i num-bytes)
  63.       (setf (elt result i) (code-char (read-byte file-stream))))
  64.     (string-right-trim (list (code-char 0)) result)))
  65.   
  66. (defun read-32-bit-integer (file-stream)
  67.   (let ((result 0))
  68.     (dotimes (i 4)
  69.       (setf result (ash result 8))
  70.       (incf result (read-byte file-stream)))
  71.     result))
  72.  
  73. (defstruct (audio-filehdr (:conc-name afhdr-))
  74.   ;; For SPARC ULAW audio files, the magic number should be #x2e736e64.
  75.   magic-number        ; magic number, 4 chars (bytes)
  76.   header-size        ; offset to the data location (byte size of header)
  77.   data-size        ; number of bytes of data
  78.   data-format        ; the data format code
  79.   sampling-rate        ; the sampling rate
  80.   channel-count        ; the number of channels
  81.   info            ; optional text information
  82.   )
  83.  
  84. (defun read-audio-filehdr (file-stream)
  85.   ;; Returns an instance of the audio-filehdr structure.
  86.   (let ((audio-filehdr (make-audio-filehdr)))
  87.     (setf (afhdr-magic-number audio-filehdr)  (read-ascii-string file-stream 4)
  88.       (afhdr-header-size audio-filehdr)   (read-32-bit-integer file-stream)
  89.       (afhdr-data-size audio-filehdr)     (read-32-bit-integer file-stream)
  90.       (afhdr-data-format audio-filehdr)   (read-32-bit-integer file-stream)
  91.       (afhdr-sampling-rate audio-filehdr) (read-32-bit-integer file-stream)
  92.       (afhdr-channel-count audio-filehdr) (read-32-bit-integer file-stream)
  93.       )
  94.     (setf (afhdr-info audio-filehdr) 
  95.       (read-ascii-string file-stream (- (afhdr-header-size audio-filehdr)
  96.                         24)))
  97.     audio-filehdr))
  98.  
  99. ;;; ********************************
  100. ;;; Output-Sounds ******************
  101. ;;; ********************************
  102.  
  103. (defvar *phoneme-directory* "/afs/cs/project/oz/oz2/mark/Speech/phonemes/")
  104. (defvar *temp-sound-file* "/tmp/tmp-sound.raw")
  105.  
  106. (defun write-sounds (sounds sound-dir out-stream)
  107.   (dolist (file sounds)
  108.     (with-open-file (in (concatenate 'string sound-dir file)
  109.             :direction :input
  110.             :element-type 'unsigned-byte)
  111.       (let ((audio-filehdr (read-audio-filehdr in)))
  112.     ;; (print audio-filehdr)
  113.     (do ((byte (read-byte in nil nil)(read-byte in nil nil)))
  114.         ((null byte))
  115.       (write-byte byte out-stream))
  116.     #|
  117.       (dotimes (i (afhdr-data-size audio-filehdr))
  118.         (setf byte (read-byte in nil nil))
  119.         (if (null byte)
  120.         (return)
  121.         (write-byte byte out)))
  122.            |#
  123.     ))))
  124.  
  125. (defun play-sounds (&optional (sounds '("AA" "r"))
  126.                   &key (blocked nil)
  127.                   (sound-dir *phoneme-directory*)
  128.                   (audio-dev "/dev/audio"))
  129.   (cond (blocked
  130.      (with-open-file (out *temp-sound-file*
  131.                   :direction :output
  132.                   :if-exists :supersede
  133.                   :if-does-not-exist :create
  134.                   :element-type 'unsigned-byte)
  135.        (write-sounds sounds sound-dir out))
  136.      (excl:run-shell-command (format nil "cat ~a > ~a" 
  137.                      *temp-sound-file* audio-dev)))
  138.     (t
  139.      (with-open-file (out audio-dev
  140.                   :direction :output
  141.                   :if-exists :overwrite
  142.                   :element-type 'unsigned-byte)
  143.        (write-sounds sounds sound-dir out)))))
  144.  
  145. ;;; ********************************
  146. ;;; Dead Code **********************
  147. ;;; ********************************
  148.  
  149. #|
  150. (defun read-sound-files (&optional (sounds '("AA" "r"))
  151.                    (dir *phoneme-directory*))
  152.   (let ((output nil))
  153.     (dolist (file sounds)
  154.       (with-open-file (in (concatenate 'string dir file) :direction :input
  155.               :element-type 'unsigned-byte)
  156.     (let ((audio-filehdr (read-audio-filehdr in)))
  157.       ;; (print audio-filehdr)
  158.       (do ((byte (read-byte in nil nil)(read-byte in nil nil)))
  159.           ((null byte))
  160.         (push byte output)))))
  161.     (nreverse output)))
  162.  
  163. (defun play-bytes (bytes &optional (audio "/dev/audio"))
  164.   (with-open-file (out audio :direction :output :if-exists :overwrite
  165.                :element-type 'unsigned-byte)
  166.     (dolist (byte bytes)
  167.       (write-byte byte out))))
  168.  
  169. (defun write-sound-bytes-to-file (bytes ofile)
  170.   (with-open-file (out ofile :direction :output :if-exists :overwrite
  171.                :if-does-not-exist :create
  172.                :element-type 'unsigned-byte)
  173.     (dolist (byte bytes)
  174.       (write-byte byte out))))
  175. |#
  176.  
  177. ;;; *EOF*
  178.