Hi!
Has anybody got a package or some code for reading audiofiles
(especially wav-files) in Common Lisp?
I have been struggling a bit with Nyquist lately, and now I am likely
to give Common Lisp a try instead. The lack of decent array-handling
is one reason.
I have seen a post of an IEEE floating point package here in this
group. I haven't looked at it, but perhaps it could be used to assist
importing floating-point wav-files? I know, I can just reimplement
the perl-module for doing this (and make it handle 32-bit as well...)
Eivind L. Rygge
Eivind L. Rygge wrote:
> Has anybody got a package or some code for reading audiofiles
> (especially wav-files) in Common Lisp?
Appended below is some code I hacked together quickly a few yeas ago.
Without reviewing it carefully, I believe it currently handles only
mono wav files, and I'm not sure whether I ever tested the file-writing
portions. The reading portions are known to work, and that's all I
needed for the system I was writing.
The code is copyright, but permission for noncommercial use is freely
granted.
If you or anyone else grabs this code and extends it (perhaps to handle
stereo) I'd be happy to receive back the changes.
The format of Windows .wav files is fairly well documented in the
Microsoft MSDN which is also available online at microsoft.com.
I haven't looked carefuly in a long time at the code appended below,
but I hereby self-nominate "dump-a-chunk" as one of the coolest CL
function names committed to code in the last years of the second
millenium.
========== win-vav.cl
;;; This file and the contained code copyright (c) 1999 Steven M. Haflich.
;;; All rights reserved.
;;; Permission for non-commercial use of this code is hereby granted.
;;; Reading and writing Windows .wav files in ACL.
;;; A typical WAV file:
;;; "RIFF"
;;; ulong ; total bytes following this word
;;; "WAVE"
;;; "fmt " ; chunk
;;; "fact" ; chunk
;;; "data" ; chunk
(in-package :user)
(defclass wav-file ()
((format-tag :accessor format-tag :initarg :format-tag)
(tot-length :accessor tot-length :initarg :tot-length)
(channels :accessor channels :initarg :channels)
(samples/sec :accessor samples/sec :initarg :samples/sec)
(avgb/sec :accessor avgb/sec :initarg :avgb/sec)
(block-align :accessor block-align :initarg :block-align)
(file-name :accessor file-name :initarg :file-name)
;; Gensym with symbol-value set to a 2d (frames * bands) float array.
;; The gensym hides the huge array from describe and friends.
(data-gensym :accessor data-gensym :initform (make-symbol ""))))
(defmethod data ((wav-file wav-file))
(symbol-value (data-gensym wav-file)))
(defmethod (setf data) (data (wav-file wav-file))
(setf (symbol-value (data-gensym wav-file)) data))
(defclass pcm-wav-file (wav-file)
((bits/sample :accessor bits/sample :initarg :bits/sample)
(mystery-num :accessor mystery-num :initarg :mystery-num)
(samp-count :accessor samp-count :initarg :samp-count)))
(defmethod copy-wav ((wav-file wav-file))
(let ((new
(loop with class = (class-of wav-file)
with new = (make-instance class)
for slot in (clos:class-slots class)
unless (eq (clos:slot-definition-name slot) 'data)
do (when (clos:slot-boundp-using-class class wav-file slot)
(setf (clos:slot-value-using-class class new slot)
(clos:slot-value-using-class class wav-file slot)))
finally (return new))))
(when (slot-boundp wav-file 'data)
(let ((a (slot-value wav-file 'data)))
(when (arrayp a)
(setf (slot-value new 'data)
(make-array (array-dimensions a)
:element-type (array-element-type a)
:initial-element (coerce 0.0 (array-element-type a)))))))
new))
(defmacro with-reading-wav-file ((stream-var filename header-var reader-var &rest args)
&body body)
`(flet ((with-reading-wav-file-continuation (,stream-var ,header-var ,reader-var) ,@body))
(declare (dynamic-extent #'with-reading-wav-file-continuation))
(with-reading-wav-file-1 ,filename (list ,@args) #'with-reading-wav-file-continuation)))
(defun with-reading-wav-file-1 (filename args continuation)
(with-open-stream (s (apply #'open filename
:element-type '(unsigned-byte 8)
args))
(let* ((header (read-wav-header s :file-name filename))
(reader (case (block-align header)
(1 (lambda (s) ; unsigned int 0..80..FF
(single-float (- (read-byte s) #x80))))
(2 (lambda (s) ; signed int 8000..0..7FFF
(let ((x (+ (read-byte s)
(ash (read-byte s) 8))))
(single-float
(if (= 0 (logand x #x8000))
x
(logior #x-10000 x))))))
(t (error "Can only handle 1 or 2 bytes/sample: ~s"
(block-align header))))))
(funcall continuation s header reader))))
(defmacro with-writing-wav-file ((stream-var filename header writer-var &rest args) &body body)
`(flet ((with-open-wav-file-continuation (,stream-var ,writer-var) ,@body))
(declare (dynamic-extent #'with-open-wav-file-continuation))
(with-writing-wav-file-1 ,filename
,header (list ,@args) #'with-open-wav-file-continuation)))
(defun with-writing-wav-file-1 (filename header args continuation)
(with-open-stream (s (apply #'open filename
:element-type '(unsigned-byte 8)
:direction :output
args))
(write-character-string "RIFF" s)
(let ((tot-len-position (file-position s))
(writer (case (block-align header)
(1 (lambda (sample s) ; unsigned int 0..80..FF
(let ((low-limit #x00)
(hih-limit #xFF)
(int (+ #x80 (round sample))))
(cond ((< int low-limit)
(setq int low-limit))
((> int hih-limit)
(setq int hih-limit)))
(write-byte int s))))
(2 (lambda (sample s) ; signed int 8000..0..7FFF
(let ((low-limit #x-8000)
(hih-limit #x7FFF)
(int (round sample)))
(cond ((< int low-limit)
(setq int low-limit))
((> int hih-limit)
(setq int hih-limit)))
;; (format t "~4,'0x ~10f~%" int sample)
(write-byte (logand int #XFF) s)
(write-byte (logand (ash int -8) #XFF) s))))
(t (error "Can only handle 1 or 2 bytes/sample: ~s"
(block-align header))))))
(write-ulong 0 s) ; Space for total file length.
(write-character-string "WAVE" s)
(write-wav-format-chunk header s)
(multiple-value-prog1
(funcall continuation s writer)
(let ((len (- (file-position s) 8)))
(file-position s tot-len-position)
(write-ulong len s))))))
(defun read-wav-format-chunk (s tot-length keys)
(expect s "fmt ") ; Unconditional?
(let ((len (read-ulong s)))
(unless (or (= len 18) (= len 16))
(error "Bad length of fmt chunk (~s) on ~s" len s))
(let ((format-tag (read-uword s)))
(unless (eql format-tag 1)
(error "Only know how to read PCM wave files -- got format-tag ~s on ~s"
format-tag s))
(apply #' make-instance 'pcm-wav-file
:format-tag format-tag
:tot-length tot-length
:channels (read-uword s)
:samples/sec (read-ulong s)
:avgb/sec (read-ulong s)
:block-align (read-uword s)
:bits/sample (read-uword s)
:mystery-num (and (= len 18) (read-uword s))
keys))))
(defun write-wav-format-chunk (wav-file s)
(with-slots (format-tag channels samples/sec avgb/sec
block-align bits/sample mystery-num)
wav-file
(write-character-string "fmt " s)
(write-ulong (if mystery-num 18 16) s)
(write-uword format-tag s)
(write-uword channels s)
(write-ulong samples/sec s)
(write-ulong avgb/sec s)
(write-uword block-align s)
(write-uword bits/sample s)
(when mystery-num (write-uword mystery-num s))))
(defun write-fact-chunk (s sample-count)
(write-character-string "fmt " s)
(write-uword 4 s)
(write-ulong sample-count s))
(defun read-wav-file (pathname)
(with-reading-wav-file (s pathname header reader)
(unless (eql (channels header) 1)
(error "Can't yet process ~s channels." (channels header)))
(loop with len = (tot-length header)
while (< (file-position s) len)
do (let ((chunktype (coerce (loop repeat 4 collect (read-character s)) 'string))
(len (read-ulong s)))
;; (format t "Chunk type ~a len ~d~%" chunktype len)
(unless
(cond ((equal chunktype "fmt ")
(error "A second fmt chunk read on ~s" s))
((equal chunktype "fact")
(unless (eql len 4)
(error "Unexpected fact length ~s" len))
(setf (samp-count header) (read-ulong s)))
((equal chunktype "data")
(setf (data header) (read-wav-data-chunk s len header reader)))
(t (error "Unknown type: ~s len ~s" chunktype len)))
(file-position s (+ (file-position s) len)))))
header))
(defun read-riff-header (s)
(expect s "RIFF")
(let ((len (read-ulong s)))
;; (format t "Got 'RIFF' remaining length ~d~%" len)
(+ len 8)))
(defun read-wav-header (s &rest keys)
(let ((len (read-riff-header s)))
(expect s "WAVE")
(let ((header (read-wav-format-chunk s len keys)))
(setf (tot-length header) len)
#+never (let ((*print-array* nil))
(describe header))
header)))
(defun read-wav-data-chunk (s len header reader)
(unless header
(error "data segment without fmt segment"))
(unless (slot-boundp header 'samp-count)
(error "data segment without prior fact segment -- number of samples unknown"))
(unless (eql (* (block-align header) (samp-count header)) len)
(error "data chunk does not have proper number of samples: ~s != ~s * ~s"
len (block-align header) (samp-count header)))
(loop with a = (make-array (samp-count header) :element-type 'single-float)
for i below (samp-count header)
;; Need to fix sample size.
do (setf (aref a i) (funcall reader s))
finally (return a)))
(defun write-wav-data (header f writer)
(let ((data (data header))
(samp-count (samp-count header)))
(unless (= (length data) samp-count)
(error "length of data array ~s doesn not agree with sample count ~s"
(length data) samp-count))
(write-character-string "fact" f)
(write-ulong 4 f)
(write-ulong (samp-count header) f)
(write-character-string "data" f)
(write-ulong (* (samp-count header) (block-align header)) f)
(loop for x across data
do (funcall writer x f))
header))
(defun write-wav-file (pathname header)
(with-writing-wav-file (f pathname header writer
:if-exists :supersede :if-does-not-exist :create)
(write-wav-data header f writer)))
#+never
(defun dump-wav-file (pathname)
(with-reading-wav-file (s header pathname)
(format t "Header: ~s~%" header)
(let ((len (read-wav-header s)))
(loop while (< (file-position s) len)
do (dump-a-chunk s))
*format-chunk*)))
#+never
(defun dump-a-chunk (s)
(let ((type (coerce (loop repeat 4 collect (read-character s)) 'string))
(len (read-ulong s)))
(format t "Chunk type ~a len ~d~%" type len)
(unless
(cond ((equal type "fmt ")
(setq *format-chunk* (dump-fmt-chunk s len)))
((equal type "fact")
(setf (samp-count *format-chunk*) (dump-fact-chunk s len)))
((equal type "data")
(dump-data-chunk s len))
(t (error "Unknown type: ~s len ~s" type len)))
(file-position s (+ (file-position s) len)))))
#+never
(defun dump-fmt-chunk (s len)
(unless (eql len 18)
(error "Bad fmt chunk length ~s" len))
(let ((fmt (read-wav-format-chunk s)))
(describe fmt)
fmt))
#+never
(defun dump-fact-chunk (s len)
(unless (eql len 4)
(error "Unexpected fact length ~s" len))
(format t "Number of samples from fact chunk: ~s~%" (read-ulong s))
t)
#+never
(defun dump-data-chunk (s len)
;; Needs to understand nchannels.
(unless *format-chunk*
(error "data segment without fmt segment"))
(unless (slot-boundp *format-chunk* 'samp-count)
(error "data segment without fact segment -- number of samples unknown"))
(loop with line-len = 80
;; with range = (expt 2 (bits/sample *format-chunk*))
with i = 0
while (< i len)
do (loop with arr = (make-array `(16 ,line-len) :element-type 'character
:initial-element #\space)
for x below line-len
while (< (incf i) len)
do (setf (aref arr (truncate (read-byte s) 16) x) #\x)
finally (loop for j below 16
do (loop for i below line-len
do (write-char (aref arr j i)))
(terpri)
finally (write-line "---")))))
(defun expect (s b)
(if (arrayp b)
(loop for e across b do (expect s e))
(let ((b (if (characterp b) (char-code b) b))
(c (read-byte s)))
(if (eql c b)
t
(error "Expected #x~2,'0X got #x~2,'0X" b c)))))
;;; The binary I/O routines.
(defun read-character (s)
(code-char (read-byte s)))
(defun write-character (c s)
(write-byte (char-int c) s))
(defun write-character-string (str s)
(loop for c across str
do (write-byte (char-int c) s)))
(defun read-uword (s)
(logior (read-byte s) (ash (read-byte s) 8)))
(defun write-uword (w s)
(write-byte (logand #xff w) s)
(write-byte (logand #xff (ash w -8)) s)
w)
(defun read-ulong (s)
(logior (read-byte s)
(ash (read-byte s) 8)
(ash (read-byte s) 16)
(ash (read-byte s) 24)))
(defun write-ulong (w s)
(write-byte (logand #xff w) s)
(write-byte (logand #xff (ash w -8)) s)
(write-byte (logand #xff (ash w -16)) s)
(write-byte (logand #xff (ash w -24)) s)
w)
"Steven M. Haflich" <·················@alum.mit.edu> writes:
> Eivind L. Rygge wrote:
>
> > Has anybody got a package or some code for reading audiofiles
> > (especially wav-files) in Common Lisp?
>
> Appended below is some code I hacked together quickly a few yeas ago.
> Without reviewing it carefully, I believe it currently handles only
> mono wav files, and I'm not sure whether I ever tested the file-writing
> portions. The reading portions are known to work, and that's all I
> needed for the system I was writing.
>
> The code is copyright, but permission for noncommercial use is freely
> granted.
>
> If you or anyone else grabs this code and extends it (perhaps to handle
> stereo) I'd be happy to receive back the changes.
> The format of Windows .wav files is fairly well documented in the
> Microsoft MSDN which is also available online at microsoft.com.
>
> I haven't looked carefuly in a long time at the code appended below,
> but I hereby self-nominate "dump-a-chunk" as one of the coolest CL
> function names committed to code in the last years of the second
> millenium.
Thank you! I will notify you of my (un)success when I have had the
time to look closer at it :-)
Eivind L. Rygge
Hi
I'm familiar with Nyquist and the conversion between arrays and sound
objects is possible just not particularly efficient. What are you
ultimately trying to do? Given Nyquist extensive signal processing
facilities there may be a more "nyquist way" of doing it. Also take a
look at "Common Lisp Music". I'm not familiar with it myself but it could
offer what your looking for.
Eivind L. Rygge wrote:
> Hi!
>
> Has anybody got a package or some code for reading audiofiles
> (especially wav-files) in Common Lisp?
>
> I have been struggling a bit with Nyquist lately, and now I am likely
> to give Common Lisp a try instead. The lack of decent array-handling
> is one reason.
>
> I have seen a post of an IEEE floating point package here in this
> group. I haven't looked at it, but perhaps it could be used to assist
> importing floating-point wav-files? I know, I can just reimplement
> the perl-module for doing this (and make it handle 32-bit as well...)
>
>
> Eivind L. Rygge
I'm late to this thread, but can verify that Common Lisp Music (CLM) can
help you out, with many ancillary functions thrown in. The Snd editor,
also from the same crew at Stanford/CCRMA, includes a nifty Scheme
interpreter.
Drew Krause
sj wrote:
>Hi
>I'm familiar with Nyquist and the conversion between arrays and sound
>objects is possible just not particularly efficient. What are you
>ultimately trying to do? Given Nyquist extensive signal processing
>facilities there may be a more "nyquist way" of doing it. Also take a
>look at "Common Lisp Music". I'm not familiar with it myself but it could
>offer what your looking for.
>
>
>Eivind L. Rygge wrote:
>
>
>
>>Hi!
>>
>>Has anybody got a package or some code for reading audiofiles
>>(especially wav-files) in Common Lisp?
>>
>>I have been struggling a bit with Nyquist lately, and now I am likely
>>to give Common Lisp a try instead. The lack of decent array-handling
>>is one reason.
>>
>>I have seen a post of an IEEE floating point package here in this
>>group. I haven't looked at it, but perhaps it could be used to assist
>>importing floating-point wav-files? I know, I can just reimplement
>>the perl-module for doing this (and make it handle 32-bit as well...)
>>
>>
>>Eivind L. Rygge
>>
>>
>
>
>
From: Christophe Rhodes
Subject: Re: Computing on samples in audio/wav-files
Date:
Message-ID: <sqk6s9637j.fsf@cam.ac.uk>
--=-=-=
······@hotmail.com (Eivind L. Rygge) writes:
> Has anybody got a package or some code for reading audiofiles
> (especially wav-files) in Common Lisp?
>
> I have been struggling a bit with Nyquist lately, and now I am likely
> to give Common Lisp a try instead. The lack of decent array-handling
> is one reason.
>
> I have seen a post of an IEEE floating point package here in this
> group. I haven't looked at it, but perhaps it could be used to assist
> importing floating-point wav-files? I know, I can just reimplement
> the perl-module for doing this (and make it handle 32-bit as well...)
The below is (part of) my implementation for reading wav files. It
works from a signal processing basis: rather than attempt to read in
the whole thing at once, it explicitly requires you to step through it
with a certain frame size. I'm happy for this code to be treated as
being in the public domain; the health warning is that I haven't (yet)
used it in anger.
Christophe
--=-=-=
Content-Disposition: inline; filename=wav.lisp
Content-Description: wav file reading
(in-package :sound-impl)
(defclass wav-file ()
((stream :initarg :stream)
(chunk-id)
(chunk1-size)
(format)
(subchunk1-id)
(subchunk1-size)
(audio-format)
(num-channels :accessor num-channels)
(sample-rate :accessor sample-rate)
(byte-rate)
(block-align)
(bits-per-sample)
(subchunk2-id)
(subchunk2-size)
(frame)))
(defmethod print-object ((w wav-file) stream)
(print-unreadable-object (w stream :type t :identity t)
(when (slot-boundp w 'num-channels)
(format stream "~S ~D" :channels (num-channels w)))
(when (and (slot-boundp w 'num-channels)
(slot-boundp w 'sample-rate))
(format stream " "))
(when (slot-boundp w 'sample-rate)
(format stream "~S ~D" :sample-rate (sample-rate w)))))
(defclass frame ()
((wav-file :initarg :wav-file)
(data :initarg :data)
(length :initarg :length)
(position :initarg :position)))
(defmethod print-object ((f frame) stream)
(print-unreadable-object (f stream :type t)
(with-slots (length position data) f
(format stream "~S ~D ~S ~D " :length length :position position)
(let ((*print-length* (or *print-length* 5)))
(format stream "~S ~S" :data data)))))
(defun frame (wav-file length)
(let ((frame (make-instance 'frame :position (- length) :length length
:wav-file wav-file
:data (loop repeat (num-channels wav-file)
collect (make-array length :element-type 'double-float)))))
(setf (slot-value wav-file 'frame) frame)
(advance wav-file length)))
(defgeneric advance (object delta))
(defmethod advance ((wav-file wav-file) delta)
(let* ((stream (slot-value wav-file 'stream))
(read-fun (ecase (slot-value wav-file 'bits-per-sample)
(8 (lambda ()
(/ (- (read-byte stream nil 0) 128) 128d0)))
(16 (lambda ()
(/ (read-signed-little-endian-2 stream nil 0)
32768d0))))))
(with-slots (frame subchunk2-size num-channels bits-per-sample) wav-file
(with-slots (data position) frame
(when (>= (incf position delta)
(/ subchunk2-size num-channels (/ bits-per-sample 8)))
(decf position delta)
(return-from advance nil))
(dolist (array data)
(declare (type (simple-array double-float (*)) array))
(replace array array :end1 (- (length array) delta) :start2 delta))
(dotimes (i delta)
(dolist (array data)
(declare (type (simple-array double-float (*)) array))
(setf (aref array (+ (- (length array) delta) i))
(funcall read-fun)))))
frame)))
(defmethod advance ((frame frame) delta)
(advance (slot-value frame 'wav-file) delta))
(defun read-signed-little-endian-2 (stream &optional (eof-error-p t) eof-value)
(declare (optimize speed))
(let ((answer (read-little-endian-2 stream eof-error-p nil)))
(if answer
(locally (declare (type (unsigned-byte 16) answer))
(if (> answer 32767)
(- answer 65536)
answer))
eof-value)))
(defun read-little-endian-2 (stream &optional (eof-error-p t) eof-value)
(declare (optimize speed))
(let ((answer (read-byte stream eof-error-p nil)))
(if answer
(locally (declare (type (unsigned-byte 16) answer))
(setf (ldb (byte 8 8) answer)
(the (unsigned-byte 8) (read-byte stream))))
(setf answer eof-value))
answer))
(defun read-little-endian-4 (stream &optional (eof-error-p t) eof-value)
(let ((answer (read-byte stream eof-error-p nil)))
(if answer
(progn
(setf (ldb (byte 8 8) answer) (read-byte stream))
(setf (ldb (byte 8 16) answer) (read-byte stream))
(setf (ldb (byte 8 24) answer) (read-byte stream)))
(setf answer eof-value))
answer))
(defmacro read-id (expected)
(let ((answer (gensym "ANSWER")))
`(let ((,answer (loop repeat 4 collect (read-byte stream))))
(unless (equal ,answer ',(map 'list #'char-code expected))
(error "Bad ID read: expected 0x~{~2,'0X~} (~S), got 0x~{~2,'0X~} (~S)."
',(map 'list #'char-code expected) ,expected
,answer (map 'string #'code-char ,answer))))))
(defun open-wav-file (filename)
(let* ((stream (open filename :element-type '(unsigned-byte 8)))
(file (make-instance 'wav-file :stream stream)))
(with-slots (chunk-id chunk1-size format) file
(setf chunk-id (read-id "RIFF"))
(setf chunk1-size (read-little-endian-4 stream))
(setf format (read-id "WAVE")))
(with-slots (subchunk1-id
subchunk1-size audio-format num-channels
sample-rate byte-rate block-align bits-per-sample)
file
(setf subchunk1-id (read-id "fmt "))
(setf subchunk1-size (read-little-endian-4 stream))
(setf audio-format (read-little-endian-2 stream))
(setf num-channels (read-little-endian-2 stream))
(setf sample-rate (read-little-endian-4 stream))
(setf byte-rate (read-little-endian-4 stream))
(setf block-align (read-little-endian-2 stream))
(setf bits-per-sample (read-little-endian-2 stream)))
(with-slots (subchunk2-id subchunk2-size) file
(setf subchunk2-id (read-id "data"))
(setf subchunk2-size (read-little-endian-4 stream)))
file))
(defun close-wav-file (wav-file)
(declare (type wav-file wav-file))
(close (slot-value wav-file 'stream)))
--=-=-=--