SampledSound WAVE Reading Patch

Andreas Raab raab at isgnw.cs.Uni-Magdeburg.DE
Tue Jan 27 23:23:50 UTC 1998


John,

looks like today is file-format-day ;-) Since I was already investigating
multi-media and associated stuff I quickly added a method for reading .wav
files. It's a bit slow because SampledSound is mono by default and I had
to split up the data stream into different buffer and mix them afterwards.
Anyways, I hope you like it.

Have fun,
  Andreas

PS. Can you tell me how to load such a sound into the SoundSequencerMorph?!

------------------------------------------------------------------------

'From Squeak 1.3 of Jan 16, 1998 on 27 January 1998 at 11:57:55 pm'!

!SampledSound class methodsFor: 'instance creation' stamp: 'ar 1/27/98 23:55'!
fromWaveFileNamed: fileName
	"(SampledSound fromWaveFileNamed: 'c:\windows\media\chimes.wav') play"
	"| snd fd |
	fd := FileDirectory on:'c:\windows\media\'.
	fd fileNames do: [:n |
		(n asLowercase endsWith: '.wav')
			ifTrue: [
				snd _ SampledSound fromWaveFileNamed: (fd pathName,n).
				snd play.
				SoundPlayer waitUntilDonePlaying: snd]]."
	| header stream data type channels samplingRate blockAlign bitsPerSample 
	leftData rightData index dataWord |
	stream := FileStream oldFileNamed: fileName.
	header := self readWaveChunk:'fmt ' inRIFF: stream.
	data := self readWaveChunk: 'data' inRIFF: stream.
	stream close.
	stream := ReadStream on: header.
	type := self next16BitWord: false from: stream.
	type = 1 ifFalse:[^self error:'Unexpected wave format'].
	channels := self next16BitWord: false from: stream.
	(channels < 1 or:[channels > 2]) ifTrue:[^self error:'Unexpected number of wave channels'].
	samplingRate := self next32BitWord: false from: stream.
	stream skip: 4. "Skip average bytes per second"
	blockAlign := self next16BitWord: false from: stream.
	bitsPerSample := self next16BitWord: false from: stream.
	(bitsPerSample = 8 or:[bitsPerSample = 16]) ifFalse:[
		"Recompute bits per sample"
		bitsPerSample := (blockAlign // channels) * 8.
	].
	bitsPerSample = 8 ifTrue:[
		data := self convert8bitUnsignedTo16Bit: data.
	].
	channels = 2 ifTrue:[
		leftData := SoundBuffer newMonoSampleCount: data size.
		rightData := SoundBuffer newMonoSampleCount: data size.
		stream := ReadStream on: data.
		index := 1.
		[stream atEnd] whileFalse:[
			dataWord := self next16BitWord: false from: stream.
			dataWord > 16r8000 ifTrue:[dataWord := dataWord - 16r10000].
			leftData at: index put: dataWord.
			dataWord := self next16BitWord: false from: stream.
			dataWord > 16r8000 ifTrue:[dataWord := dataWord - 16r10000].
			rightData at: index put: dataWord.
			index := index + 1.
		].
		^(MixedSound new)
			add: (self samples: leftData samplingRate: samplingRate) pan: 0.0;
			add: (self samples: rightData samplingRate: samplingRate) pan: 1.0;
		yourself
	].
	^self samples: data samplingRate: samplingRate.! !

!SampledSound class methodsFor: 'utilities' stamp: 'ar 1/27/98 23:11'!
convert8bitUnsignedTo16Bit: anArray
	"Convert the given array of samples--assumed to be 8-bit unsigned, linear data--into 16-bit signed samples. Return an array containing the resulting samples. Typically used to read uncompressed WAVE sound data."

	| n samples s |
	n _ anArray size.
	samples _ SoundBuffer newMonoSampleCount: n.
	1 to: n do: [:i |
		s _ anArray at: i.
		samples at: i put: (s - 128 * 256)].
	^ samples
! !

!SampledSound class methodsFor: 'WAV reading' stamp: 'ar 1/27/98 23:06'!
next16BitWord: msbFirst from: stream
	"Read a 16-bit positive integer from the input stream."
	"Assume: Stream has at least two bytes left."

	| n |
	n _ stream next: 2.
	^msbFirst
		ifTrue:[(n at: 1) * 256 + (n at: 2)]
		ifFalse:[(n at: 2) * 256 + (n at: 1)]
! !

!SampledSound class methodsFor: 'WAV reading' stamp: 'ar 1/27/98 23:06'!
next32BitWord: msbFirst from: stream
	"Read a 32-bit positive integer from the input stream."
	"Assume: Stream has at least four bytes left."

	| n |
	n _ stream next: 4.
	^msbFirst
		ifTrue:[(n at: 1) * 256 + (n at: 2) * 256 + (n at: 3) * 256 + (n at: 4)]
		ifFalse:[(n at: 4) * 256 + (n at: 3) * 256 + (n at: 2) * 256 + (n at: 1)]
! !

!SampledSound class methodsFor: 'WAV reading' stamp: 'ar 1/27/98 23:06'!
readChunkTypeFrom: stream
	| s |
	s _ String new: 4.
	1 to: 4 do: [:i | s at: i put: (stream next) asCharacter].
	^ s
! !

!SampledSound class methodsFor: 'WAV reading' stamp: 'ar 1/27/98 23:06'!
readWaveChunk: chunkType inRIFF: stream
	"Search the stream for a format chunk and return its contents"
	| dwLength fourcc |
	"Get to binary and skip 'RIFF'"
	stream reset; binary; skip: 4.
	"Read length of all data"
	dwLength := self next32BitWord: false from: stream.
	"Get RIFF contents type "
	fourcc := self readChunkTypeFrom: stream.
	fourcc = 'WAVE' ifFalse:[^nil]. "We can only read WAVE files here"
	"Search for chunk"
	[fourcc := self readChunkTypeFrom: stream.
	dwLength := self next32BitWord: false from: stream.
	fourcc = chunkType] whileFalse:[
		"Skip chunk - rounded to word boundary"
		stream skip: (dwLength + 1 bitAnd: 16rFFFFFFFE).
		stream atEnd ifTrue:[^'']].
	"Return raw data"
	^stream next: dwLength! !

------------------------------------------------------------------------


-- 
Linear algebra is your friend - Trigonometry is your enemy.
+===== Andreas Raab ============= (raab at isg.cs.uni-magdeburg.de) =====+
I Department of Simulation and Graphics      Phone: +49 391 671 8065  I
I University of Magdeburg, Germany           Fax:   +49 391 671 1164  I
+=============< http://isgwww.cs.uni-magdeburg.de/~raab >=============+





More information about the Squeak-dev mailing list