'From R&DSqueak2.8 of 6 June 2001 [latest update: #28] on 26 November 2001 at 7:02:15 am'! "Change Set: streamingSound-jm Date: 26 November 2001 Author: John Maloney Adds support for the creation and playback of monophonic streaming sampled sounds. The sounds can be compressed using any of Squeak's sound codecs. Random access (i.e. moving the playback position) is supported. Compatible with StreamingMP3Sound. Note: Random access does not work perfectly with the ADPCM codec. A fix is forthcoming. For now, mulaw or gsm compression are recommended." ! AbstractSound subclass: #StreamingMonoSound instanceVariableNames: 'stream volume repeat headerStart audioDataStart streamSamplingRate totalSamples codec mixer leftoverSamples ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! !StreamingMonoSound commentStamp: 'jm 11/21/2001 18:44' prior: 0! I implement a streaming player for monophonic Sun (.au) and AIFF (.aif) audio files. Example of use: (StreamingMonoSound onFileNamed: 'song.aif') play. ! !StreamingMonoSound methodsFor: 'initialization' stamp: 'jm 11/16/2001 10:23'! initStream: aStream headerStart: anInteger "Initialize for streaming from the given stream. The audio file header starts at the given stream position." stream _ aStream. volume _ 1.0. repeat _ false. headerStart _ anInteger. self reset. ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 11/16/2001 17:12'! duration "Answer the duration of this sound in seconds." ^ totalSamples asFloat / streamSamplingRate ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 10/18/2001 15:46'! repeat "Answer the repeat flag." ^ repeat ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 6/3/2001 18:39'! repeat: aBoolean "Set the repeat flag. If true, this sound will loop back to the beginning when it gets to the end." repeat _ aBoolean. ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 11/16/2001 17:05'! soundPosition "Answer the relative position of sound playback as a number between 0.0 and 1.0." (stream isNil or: [stream closed]) ifTrue: [^ 0.0]. ^ self currentSampleIndex asFloat / totalSamples ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 11/25/2001 16:12'! soundPosition: fraction "Jump to the position the given fraction through the sound file. The argument is a number between 0.0 and 1.0." | sampleIndex frameIndex | (stream isNil or: [stream closed]) ifTrue: [^ self]. sampleIndex _ ((totalSamples * fraction) truncated max: 0) min: totalSamples. codec ifNil: [stream position: audioDataStart + (sampleIndex * 2)] ifNotNil: [ frameIndex _ sampleIndex // codec samplesPerFrame. stream position: audioDataStart + (frameIndex * codec bytesPerEncodedFrame). codec reset]. leftoverSamples _ SoundBuffer new. ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 11/20/2001 16:59'! streamSamplingRate "Answer the sampling rate of the MP3 stream." ^ streamSamplingRate ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 9/26/2000 07:49'! volume "Answer my volume." ^ volume ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 5/30/2001 16:53'! volume: aNumber "Set my volume to the given number between 0.0 and 1.0." volume _ aNumber. self createMixer. ! ! !StreamingMonoSound methodsFor: 'playing' stamp: 'jm 11/8/2001 08:59'! millisecondsSinceStart "Answer the number of milliseconds of this sound started playing." (stream isNil or: [stream closed]) ifTrue: [^ 0]. ^ self currentSampleIndex * 1000 // streamSamplingRate ! ! !StreamingMonoSound methodsFor: 'playing' stamp: 'jm 10/18/2001 14:54'! playSampleCount: n into: aSoundBuffer startingAt: startIndex "Mix the next n samples of this sound into the given buffer starting at the given index" self repeat ifTrue: [ "loop if necessary" (totalSamples - self currentSampleIndex) < n ifTrue: [self startOver]]. self loadBuffersForSampleCount: (n * streamSamplingRate) // SoundPlayer samplingRate. mixer playSampleCount: n into: aSoundBuffer startingAt: startIndex. ! ! !StreamingMonoSound methodsFor: 'playing' stamp: 'jm 10/21/2001 09:45'! reset super reset. self startOver. self createMixer. ! ! !StreamingMonoSound methodsFor: 'playing' stamp: 'jm 11/8/2001 09:09'! samplesRemaining "Answer the number of samples remaining to be played." | result | (stream isNil or: [stream closed]) ifTrue: [^ 0]. self repeat ifTrue: [^ 1000000]. result _ (totalSamples - self currentSampleIndex) max: 0. result <= 0 ifTrue: [self closeFile]. ^ result ! ! !StreamingMonoSound methodsFor: 'other' stamp: 'jm 11/25/2001 14:11'! closeFile "Close my stream, if it responds to close." self pause. stream ifNotNil: [ (stream respondsTo: #close) ifTrue: [stream close]]. totalSamples _ 0. mixer _ nil. codec _ nil. ! ! !StreamingMonoSound methodsFor: 'other' stamp: 'jm 11/21/2001 08:05'! extractFrom: startSecs to: endSecs "Extract a portion of this sound between the given start and end times. The current implementation only works if the sound is uncompressed." | emptySound first last sampleCount byteStream sndBuf | codec ifNotNil: [^ self error: 'only works on uncompressed sounds']. emptySound _ SampledSound samples: SoundBuffer new samplingRate: streamSamplingRate. first _ (startSecs * streamSamplingRate) truncated max: 0. last _ ((endSecs * streamSamplingRate) truncated min: totalSamples) - 1. first >= last ifTrue: [^ emptySound]. codec ifNotNil: [self error: 'extracting from compressed sounds is not supported']. sampleCount _ last + 1 - first. stream position: audioDataStart + (2 * first). byteStream _ ReadStream on: (stream next: 2 * sampleCount). sndBuf _ SoundBuffer newMonoSampleCount: sampleCount. 1 to: sampleCount do: [:i | sndBuf at: i put: byteStream int16]. ^ SampledSound samples: sndBuf samplingRate: streamSamplingRate ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 10/18/2001 15:51'! createMixer "Create a mixed sound consisting of sampled sounds with one sound buffer's worth of samples." | snd | mixer _ MixedSound new. snd _ SampledSound samples: (SoundBuffer newMonoSampleCount: 2) "buffer size will be adjusted dynamically" samplingRate: streamSamplingRate. mixer add: snd pan: 0.5 volume: volume. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/21/2001 09:05'! currentSampleIndex "Answer the index of the current sample." | bytePosition frameIndex | bytePosition _ stream position - audioDataStart. codec ifNil: [^ bytePosition // 2] ifNotNil: [ frameIndex _ bytePosition // codec bytesPerEncodedFrame. ^ (frameIndex * codec samplesPerFrame) - leftoverSamples monoSampleCount]. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/21/2001 11:37'! loadBuffer: aSoundBuffer compressedSampleCount: sampleCount "Load the given sound buffer from the compressed sample stream." "Details: Most codecs decode in multi-sample units called 'frames'. Since the requested sampleCount is typically not an even multiple of the frame size, we need to deal with partial frames. The unused samples from a partial frame are retained until the next call to this method." | n samplesNeeded frameCount encodedBytes r decodedCount buf j | "first, use any leftover samples" n _ self loadFromLeftovers: aSoundBuffer sampleCount: sampleCount. samplesNeeded _ sampleCount - n. samplesNeeded <= 0 ifTrue: [^ self]. "decode an integral number of full compression frames" frameCount _ samplesNeeded // codec samplesPerFrame. encodedBytes _ stream next: (frameCount * codec bytesPerEncodedFrame). r _ codec decodeFrames: frameCount from: encodedBytes at: 1 into: aSoundBuffer at: n + 1. decodedCount _ r last. decodedCount >= samplesNeeded ifTrue: [^ self]. "decode one last compression frame to finish filling the buffer" buf _ SoundBuffer newMonoSampleCount: codec samplesPerFrame. encodedBytes _ stream next: codec bytesPerEncodedFrame. codec decodeFrames: 1 from: encodedBytes at: 1 into: buf at: 1. j _ 0. (n + decodedCount + 1) to: sampleCount do: [:i | aSoundBuffer at: i put: (buf at: (j _ j + 1))]. "save the leftover samples" leftoverSamples _ buf copyFrom: (j + 1) to: buf monoSampleCount. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/21/2001 08:03'! loadBuffer: aSoundBuffer uncompressedSampleCount: sampleCount "Load the given sound buffer from the uncompressed sample stream." "read directly into the sample buffer; count is in 32-bit words" stream next: sampleCount // 2 into: aSoundBuffer startingAt: 1. aSoundBuffer restoreEndianness. "read the final sample if sampleCount is odd:" sampleCount odd ifTrue: [aSoundBuffer at: sampleCount put: stream int16]. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/21/2001 08:02'! loadBuffersForSampleCount: count "Load the sound buffers from the stream." | snd buf sampleCount | snd _ mixer sounds first. buf _ snd samples. buf monoSampleCount = count ifFalse: [ buf _ SoundBuffer newMonoSampleCount: count. snd setSamples: buf samplingRate: streamSamplingRate]. sampleCount _ count min: (totalSamples - self currentSampleIndex). sampleCount < count ifTrue: [buf primFill: 0]. codec ifNil: [self loadBuffer: buf uncompressedSampleCount: sampleCount] ifNotNil: [self loadBuffer: buf compressedSampleCount: sampleCount]. mixer reset. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/21/2001 09:09'! loadFromLeftovers: aSoundBuffer sampleCount: sampleCount "Load the given sound buffer from the samples leftover from the last frame. Answer the number of samples loaded, which typically is less than sampleCount." | leftoverCount n | leftoverCount _ leftoverSamples monoSampleCount. leftoverCount = 0 ifTrue: [^ 0]. n _ leftoverCount min: sampleCount. 1 to: n do: [:i | aSoundBuffer at: i put: (leftoverSamples at: i)]. n < sampleCount ifTrue: [leftoverSamples _ SoundBuffer new] ifFalse: [leftoverSamples _ leftoverSamples copyFrom: n + 1 to: leftoverSamples size]. ^ n ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/16/2001 10:23'! readAIFFHeader "Read an AIFF file header from stream." | aiffReader | aiffReader _ AIFFFileReader new. aiffReader readFromStream: stream mergeIfStereo: false skipDataChunk: true. aiffReader channelCount = 1 ifFalse: [self error: 'not monophonic']. aiffReader bitsPerSample = 16 ifFalse: [self error: 'not 16-bit']. audioDataStart _ headerStart + aiffReader channelDataOffset. streamSamplingRate _ aiffReader samplingRate. totalSamples _ aiffReader frameCount min: (stream size - audioDataStart) // 2. codec _ nil. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/16/2001 10:32'! readHeader "Read the sound file header from my stream." | id | stream position: headerStart. id _ (stream next: 4) asString. stream position: headerStart. id = '.snd' ifTrue: [^ self readSunAudioHeader]. id = 'FORM' ifTrue: [^ self readAIFFHeader]. self error: 'unrecognized sound file format'. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/21/2001 13:02'! readSunAudioHeader "Read a Sun audio file header from my stream." | id headerBytes dataBytes format channelCount | id _ (stream next: 4) asString. headerBytes _ stream uint32. "header bytes" dataBytes _ stream uint32. format _ stream uint32. streamSamplingRate _ stream uint32. channelCount _ stream uint32. id = '.snd' ifFalse: [self error: 'not Sun audio format']. dataBytes _ dataBytes min: (stream size - headerBytes). channelCount = 1 ifFalse: [self error: 'not monophonic']. audioDataStart _ headerStart + headerBytes. codec _ nil. format = 1 ifTrue: [ "8-bit u-LAW" codec _ MuLawCodec new. totalSamples _ dataBytes. ^ self]. format = 3 ifTrue: [ "16-bit linear" totalSamples _ dataBytes // 2. ^ self]. format = 23 ifTrue: [ "ADPCM-4 bit (CCITT G.721)" codec _ ADPCMCodec new initializeForBitsPerSample: 4 samplesPerFrame: 0. totalSamples _ (dataBytes // 4) * 8. ^ self]. format = 25 ifTrue: [ "ADPCM-3 bit (CCITT G.723)" codec _ ADPCMCodec new initializeForBitsPerSample: 3 samplesPerFrame: 0. totalSamples _ (dataBytes // 3) * 8. ^ self]. format = 26 ifTrue: [ "ADPCM-5 bit (CCITT G.723)" codec _ ADPCMCodec new initializeForBitsPerSample: 5 samplesPerFrame: 0. totalSamples _ (dataBytes // 5) * 8. ^ self]. format = 610 ifTrue: [ "GSM 06.10 (this format was added by Squeak)" codec _ GSMCodec new. totalSamples _ (dataBytes // 33) * 160. ^ self]. self error: 'unsupported Sun audio format ', format printString ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/21/2001 09:04'! startOver "Jump back to the first sample." stream reopen; binary. self readHeader. stream position: audioDataStart. leftoverSamples _ SoundBuffer new. ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! StreamingMonoSound class instanceVariableNames: ''! !StreamingMonoSound class methodsFor: 'instance creation' stamp: 'jm 11/16/2001 16:57'! onFileNamed: fileName "Answer an instance of me for playing the file with the given name." | f | f _ FileDirectory default readOnlyFileNamed: fileName. f ifNil: [^ self error: 'could not open ', fileName]. ^ self new initStream: f headerStart: 0 ! ! !StreamingMonoSound class methodsFor: 'instance creation' stamp: 'jm 11/16/2001 10:25'! onFileNamed: fileName headerStart: anInteger "Answer an instance of me for playing audio data starting at the given position in the file with the given name." | f | f _ FileDirectory default readOnlyFileNamed: fileName. f ifNil: [^ self error: 'could not open ', fileName]. ^ self new initStream: f headerStart: anInteger ! ! Object subclass: #SunAudioFileWriter instanceVariableNames: 'stream headerStart ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! !SunAudioFileWriter commentStamp: 'jm 11/21/2001 15:55' prior: 0! I encode monophonic sampled sounds in Sun audio (.au) file format. Sun audio files have a very simple format but can store both compressed and uncompressed sample data. I can write this format either directly into a file or onto any writable binary stream. ! !SunAudioFileWriter methodsFor: 'initialization' stamp: 'jm 11/16/2001 17:51'! setStream: aBinaryStream "Initialize myself for writing on the given stream." stream _ aBinaryStream. headerStart _ aBinaryStream position. ! ! !SunAudioFileWriter methodsFor: 'other' stamp: 'jm 11/16/2001 18:02'! appendBytes: aByteArray "Append the given sample data to my stream." stream nextPutAll: aByteArray. ! ! !SunAudioFileWriter methodsFor: 'other' stamp: 'jm 11/16/2001 22:53'! appendSamples: aSoundBuffer "Append the given SoundBuffer to my stream." | swapBytes s | (stream isKindOf: StandardFileStream) ifTrue: [ "optimization: write sound buffer directly to file" swapBytes _ Smalltalk endianness == #little. swapBytes ifTrue: [aSoundBuffer reverseEndianness]. "make big endian" stream next: (aSoundBuffer size // 2) putAll: aSoundBuffer startingAt: 1. "size in words" swapBytes ifTrue: [aSoundBuffer reverseEndianness]. "revert to little endian" ^ self]. "for non-file streams:" s _ WriteStream on: (ByteArray new: 2 * aSoundBuffer monoSampleCount). 1 to: aSoundBuffer monoSampleCount do: [:i | s int16: (aSoundBuffer at: i)]. self appendBytes: s contents. ! ! !SunAudioFileWriter methodsFor: 'other' stamp: 'jm 11/16/2001 22:09'! closeFile "Update the Sun audio file header to reflect the final size of the sound data. If my stream is a file stream, close it and, on a Macintosh, set the file type and creator to that used by SoundApp for Sun Audio files. (This does nothing on other platforms.)" self ensureOpen. self updateHeaderDataSize. (stream isKindOf: StandardFileStream) ifTrue: [ stream close. FileDirectory default setMacFileNamed: stream name type: 'ULAW' creator: 'SCPL']. ! ! !SunAudioFileWriter methodsFor: 'other' stamp: 'jm 11/16/2001 18:28'! ensureOpen "Ensure that my stream is open." (stream respondsTo: #closed) ifFalse: [^ self]. stream closed ifTrue: [stream reopen; binary]. ! ! !SunAudioFileWriter methodsFor: 'other' stamp: 'jm 11/16/2001 17:55'! updateHeaderDataSize "Update the Sun audio file header to reflect the final size of the sound data." | byteCount | byteCount _ stream position - (headerStart + 24). stream position: headerStart + 8. stream uint32: byteCount. ! ! !SunAudioFileWriter methodsFor: 'other' stamp: 'jm 11/16/2001 17:55'! writeHeaderSamplingRate: samplingRate "Write a Sun audio file header for 16-bit linear format." self writeHeaderSamplingRate: samplingRate format: 3. ! ! !SunAudioFileWriter methodsFor: 'other' stamp: 'jm 11/16/2001 22:10'! writeHeaderSamplingRate: samplingRate format: audioFormat "Write a Sun audio file header for the given sampling rate and format. Currently, only monophonic files are supported." self ensureOpen. stream position: headerStart. stream nextPutAll: '.snd' asByteArray. stream uint32: 24. "header size in bytes" stream uint32: 0. "sample data size in bytes; fill in later" stream uint32: audioFormat. stream uint32: samplingRate truncated. stream uint32: 1. "channel count" ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SunAudioFileWriter class instanceVariableNames: ''! !SunAudioFileWriter class methodsFor: 'instance creation' stamp: 'jm 11/16/2001 17:49'! onFileNamed: fileName "Answer an instance of me on a newly created file with the given name." | file | file _ (FileStream newFileNamed: fileName) binary. ^ self new setStream: file ! ! !SunAudioFileWriter class methodsFor: 'instance creation' stamp: 'jm 11/16/2001 17:50'! onStream: aBinaryStream "Answer an instance of me on the given binary stream." ^ self new setStream: aBinaryStream ! ! !SunAudioFileWriter class methodsFor: 'sound storing' stamp: 'jm 11/21/2001 15:42'! codecForFormatCode: formatCode "Answer the codec for the given Sun audio file format number." formatCode = 1 ifTrue: [^ MuLawCodec new]. formatCode = 3 ifTrue: [^ nil]. "uncompressed" formatCode = 23 ifTrue: [^ ADPCMCodec newBitsPerSample: 4]. formatCode = 25 ifTrue: [^ ADPCMCodec newBitsPerSample: 3]. formatCode = 26 ifTrue: [^ ADPCMCodec newBitsPerSample: 5]. formatCode = 610 ifTrue: [^ GSMCodec new]. self error: 'unsupported Sun audio format' ! ! !SunAudioFileWriter class methodsFor: 'sound storing' stamp: 'jm 11/21/2001 15:42'! formatCodeForCompressionType: aString "Answer the Sun audio file format number for the given compression type name." | lowercase | lowercase _ aString asLowercase. 'mulaw' = lowercase ifTrue: [^ 1]. 'none' = lowercase ifTrue: [^ 3]. 'adpcm3' = lowercase ifTrue: [^ 25]. 'adpcm4' = lowercase ifTrue: [^ 23]. 'adpcm5' = lowercase ifTrue: [^ 26]. 'gsm' = lowercase ifTrue: [^ 610]. self error: 'unknown compression style' ! ! !SunAudioFileWriter class methodsFor: 'sound storing' stamp: 'jm 11/21/2001 15:49'! storeSound: aSampledSound onFileNamed: fileName compressionType: aString "Store the samples of the given sampled sound on a file with the given name using the given type of compression. See formatCodeForCompressionType: for the list of compression types." | fmt codec f compressed | fmt _ self formatCodeForCompressionType: aString. codec _ self codecForFormatCode: fmt. f _ self onFileNamed: fileName. f writeHeaderSamplingRate: aSampledSound originalSamplingRate format: fmt. codec ifNil: [f appendSamples: aSampledSound samples] ifNotNil: [ compressed _ codec encodeSoundBuffer: aSampledSound samples. f appendBytes: compressed]. f closeFile. ! ! Object subclass: #AIFFFileReader instanceVariableNames: 'in fileType channelCount frameCount bitsPerSample samplingRate channelData channelDataOffset markers pitch gain isLooped skipDataChunk mergeIfStereo ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! AbstractSound subclass: #StreamingMP3Sound instanceVariableNames: 'volume repeat mpegFile mpegStreamIndex totalSamples streamSamplingRate mixer ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! !StreamingMP3Sound commentStamp: 'jm 11/21/2001 18:44' prior: 0! I implement a streaming player for MPEG or MP3 files. Example of use: (StreamingMP3Sound onFileNamed: 'song.mp3') play. ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 11/21/2001 11:35'! encodeLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits frameSize: frameSize forFlash: flashFlag | stereoFlag sampleCount sampleBitCount bitCount | self initializeForBitsPerSample: bits samplesPerFrame: frameSize. stereoFlag _ rightSoundBuffer notNil. sampleCount _ leftSoundBuffer monoSampleCount. stereoFlag ifTrue: [sampleBitCount _ 2 * (sampleCount * bitsPerSample)] ifFalse: [sampleBitCount _ sampleCount * bitsPerSample]. bitCount _ sampleBitCount + (self headerBitsForSampleCount: sampleCount stereoFlag: stereoFlag). encodedBytes _ ByteArray new: ((bitCount / 8) ceiling roundUpTo: self bytesPerEncodedFrame). byteIndex _ 0. bitPosition _ 0. currentByte _ 0. flashFlag ifTrue: [self nextBits: 2 put: bits - 2]. stereoFlag ifTrue: [ samples _ Array with: leftSoundBuffer with: rightSoundBuffer. sampleIndex _ Array with: 0 with: 0. self privateEncodeStereo: sampleCount] ifFalse: [ samples _ leftSoundBuffer. sampleIndex _ 0. self privateEncodeMono: sampleCount]. ^ encodedBytes ! ! !ADPCMCodec class methodsFor: 'instance creation' stamp: 'jm 11/15/2001 16:02'! newBitsPerSample: bitsPerSample ^ super new initializeForBitsPerSample: bitsPerSample samplesPerFrame: 0. ! ! !AIFFFileReader methodsFor: 'reading' stamp: 'jm 10/17/2001 17:20'! readFromFile: fileName mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag "Read the AIFF file of the given name. See comment in readFromStream:mergeIfStereo:skipDataChunk:." "AIFFFileReader new readFromFile: 'test.aiff' mergeIfStereo: false skipDataChunk: true" | f | f _ (FileStream readOnlyFileNamed: fileName) binary. self readFromStream: f mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag. f close. ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 10/20/2001 15:07'! channelDataOffset ^ channelDataOffset ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 10/20/2001 15:07'! readSamplesChunk: chunkSize "Read a SSND chunk. All AIFF files with a non-zero frameCount contain exactly one chunk of this type." | offset blockSize bytesOfSamples s | offset _ in nextNumber: 4. blockSize _ in nextNumber: 4. ((offset ~= 0) or: [blockSize ~= 0]) ifTrue: [^ self error: 'this AIFF reader cannot handle blocked sample chunks']. bytesOfSamples _ chunkSize - 8. bytesOfSamples = (channelCount * frameCount * (bitsPerSample // 8)) ifFalse: [self error: 'actual sample count does not match COMM chunk']. channelDataOffset _ in position. "record stream position for start of data" skipDataChunk ifTrue: [in skip: (chunkSize - 8). ^ self]. "if skipDataChunk, skip sample data" (mergeIfStereo and: [channelCount = 2]) ifTrue: [ channelData _ Array with: (SoundBuffer newMonoSampleCount: frameCount)] ifFalse: [ channelData _ (1 to: channelCount) collect: [:i | SoundBuffer newMonoSampleCount: frameCount]]. (bytesOfSamples < (Smalltalk garbageCollectMost - 300000)) ifTrue: [s _ ReadStream on: (in next: bytesOfSamples)] "bulk-read, then process" ifFalse: [s _ in]. "not enough space to buffer; read directly from file" "mono and stereo are special-cased for better performance" channelCount = 1 ifTrue: [^ self readMonoChannelDataFrom: s]. channelCount = 2 ifTrue: [ mergeIfStereo ifTrue: [channelCount _ 1. ^ self readMergedStereoChannelDataFrom: s] ifFalse: [^ self readStereoChannelDataFrom: s]]. self readMultiChannelDataFrom: s. ! ! !GSMCodec class methodsFor: 'instance creation' stamp: 'jm 10/21/2001 10:10'! new ^ super new reset ! ! !SoundBuffer methodsFor: 'utilities' stamp: 'jm 10/21/2001 10:43'! lowPassFiltered "Answer a simple low-pass filtered copy of this buffer. Assume it is monophonic." | sz out last this | sz _ self monoSampleCount. out _ self clone. last _ self at: 1. 2 to: sz do: [:i | this _ self at: i. out at: i put: (this + last) // 2. last _ this]. ^ out ! ! !SoundBuffer methodsFor: 'utilities' stamp: 'jm 11/15/2001 18:26'! mergeStereo "Answer a new SoundBuffer half the size of the receiver that mixes the left and right stereo channels of the receiver, which is assumed to contain stereo sound data." | n resultBuf j | n _ self monoSampleCount. resultBuf _ SoundBuffer newMonoSampleCount: n // 2. j _ 0. 1 to: n by: 2 do: [:i | resultBuf at: (j _ j + 1) put: (((self at: i) + (self at: i + 1)) // 2)]. ^ resultBuf ! ! !SoundBuffer methodsFor: 'objects from disk' stamp: 'jm 10/29/2001 19:53'! reverseEndianness "Swap the bytes of each 16-bit word, using a fast BitBlt hack." | hack blt | hack _ Form new hackBits: self. blt _ (BitBlt toForm: hack) sourceForm: hack. blt combinationRule: Form reverse. "XOR" blt sourceY: 0; destY: 0; height: self size; width: 1. blt sourceX: 0; destX: 1; copyBits. "Exchange bytes 0 and 1" blt sourceX: 1; destX: 0; copyBits. blt sourceX: 0; destX: 1; copyBits. blt sourceX: 2; destX: 3; copyBits. "Exchange bytes 2 and 3" blt sourceX: 3; destX: 2; copyBits. blt sourceX: 2; destX: 3; copyBits. ! ! !StreamingMP3Sound methodsFor: 'initialization' stamp: 'jm 11/16/2001 16:18'! initMPEGFile: anMPEGFile streamIndex: anInteger "Initialize for playing the given stream of the given MPEG or MP3 file." volume _ 0.3. repeat _ false. mpegFile _ anMPEGFile. mpegStreamIndex _ anInteger. totalSamples _ mpegFile audioSamples: mpegStreamIndex. self createMixer. ! ! !StreamingMP3Sound methodsFor: 'file ops' stamp: 'jm 11/25/2001 14:11'! closeFile "Close the MP3 or MPEG file." self pause. mpegFile ifNil: [^ self]. mpegFile closeFile. mpegFile _ nil. mixer _ nil. ! ! !StreamingMP3Sound methodsFor: 'file ops' stamp: 'jm 11/16/2001 15:58'! mpegFileIsOpen "Answer true if I have an open, valid MPEG file handle. If the handle is not valid, try to re-open the file." mpegFile ifNil: [^ false]. mpegFile fileHandle ifNil: [ "try to reopen the file, which may have been saved in a snapshot" mpegFile openFile: mpegFile fileName. mpegFile fileHandle ifNil: [mpegFile _ nil]]. ^ mpegFile notNil ! ! !StreamingMP3Sound methodsFor: 'accessing' stamp: 'jm 11/16/2001 17:16'! duration "Answer the duration of this sound in seconds." ^ totalSamples asFloat / streamSamplingRate ! ! !StreamingMP3Sound methodsFor: 'accessing' stamp: 'jm 11/16/2001 16:18'! soundPosition "Answer the relative position of sound playback as a number between 0.0 and 1.0." self mpegFileIsOpen ifFalse: [^ 0.0]. mpegFile hasAudio ifFalse: [^ 0.0]. ^ (mpegFile audioGetSample: 0) asFloat / totalSamples ! ! !StreamingMP3Sound methodsFor: 'accessing' stamp: 'jm 11/16/2001 16:19'! soundPosition: fraction "Jump to the position the given fraction through the sound file. The argument is a number between 0.0 and 1.0." | sampleIndex | self mpegFileIsOpen ifFalse: [^ self]. mpegFile hasAudio ifTrue: [ sampleIndex _ ((totalSamples * fraction) truncated max: 0) min: totalSamples. mpegFile audioSetSample: 0 stream: 0. "work around for library bug: first seek to zero" mpegFile audioSetSample: sampleIndex stream: 0]. ! ! !StreamingMP3Sound methodsFor: 'accessing' stamp: 'jm 11/16/2001 15:34'! streamSamplingRate "Answer the sampling rate of the MP3 stream." ^ streamSamplingRate ! ! !StreamingMP3Sound methodsFor: 'playing' stamp: 'jm 11/16/2001 15:59'! millisecondsSinceStart "Answer the number of milliseconds since this sound started playing." | i | mpegFile ifNil: [^ 0]. mpegFile fileHandle ifNil: [^ 0]. "mpeg file not open" i _ mpegFile audioGetSample: mpegStreamIndex. i < 0 ifTrue: [^ 0]. "movie file has no audio" ^ i * 1000 // streamSamplingRate ! ! !StreamingMP3Sound methodsFor: 'playing' stamp: 'jm 11/16/2001 15:59'! playSampleCount: n into: aSoundBuffer startingAt: startIndex "Mix the next n samples of this sound into the given buffer starting at the given index" | current | self repeat ifTrue: [ "loop if necessary" current _ mpegFile audioGetSample: mpegStreamIndex. (totalSamples - current) < n ifTrue: [ mpegFile audioSetSample: 0 stream: mpegStreamIndex]]. self loadBuffersForSampleCount: (n * streamSamplingRate) // SoundPlayer samplingRate. mixer playSampleCount: n into: aSoundBuffer startingAt: startIndex. ! ! !StreamingMP3Sound methodsFor: 'playing' stamp: 'jm 11/16/2001 15:59'! reset super reset. self createMixer. mpegFile audioSetSample: 0 stream: mpegStreamIndex. ! ! !StreamingMP3Sound methodsFor: 'playing' stamp: 'jm 11/16/2001 15:59'! samplesRemaining | samplesPlayed | mpegFile ifNil: [^ 0]. self repeat ifTrue: [^ 1000000]. samplesPlayed _ mpegFile audioGetSample: mpegStreamIndex. samplesPlayed > totalSamples ifTrue: [^ 0]. ^ totalSamples - samplesPlayed ! ! !StreamingMP3Sound methodsFor: 'converting' stamp: 'jm 11/25/2001 13:43'! storeSunAudioOn: aBinaryStream compressionType: compressionName "Store myself on the given stream as a monophonic sound compressed with the given type of compression. The sampling rate is reduced to 22050 samples/second if it is higher." | fmt inBufSize samplesPerFrame codec inBuf compressed outSamplingRate audioWriter samplesRemaining outBuf counts byteCount | fmt _ SunAudioFileWriter formatCodeForCompressionType: compressionName. inBufSize _ 64000. samplesPerFrame _ 1. codec _ SunAudioFileWriter codecForFormatCode: fmt. codec ifNotNil: [ samplesPerFrame _ codec samplesPerFrame. inBufSize _ inBufSize roundUpTo: (2 * samplesPerFrame). compressed _ ByteArray new: (inBufSize // samplesPerFrame) * codec bytesPerEncodedFrame]. inBuf _ SoundBuffer newMonoSampleCount: inBufSize. outSamplingRate _ streamSamplingRate. streamSamplingRate > 22050 ifTrue: [ streamSamplingRate = 44100 ifFalse: [self error: 'unexpected MP3 sampling rate']. outSamplingRate _ 22050]. "write audio header" audioWriter _ SunAudioFileWriter onStream: aBinaryStream. audioWriter writeHeaderSamplingRate: outSamplingRate format: fmt. "convert and write sound data" samplesRemaining _ totalSamples. [samplesRemaining > 0] whileTrue: [ samplesRemaining < inBuf monoSampleCount ifTrue: [ inBuf _ SoundBuffer newMonoSampleCount: (samplesRemaining roundUpTo: 2 * samplesPerFrame)]. mpegFile audioReadBuffer: inBuf stream: 0 channel: 0. outSamplingRate < streamSamplingRate ifTrue: [outBuf _ inBuf downSampledLowPassFiltering: true] ifFalse: [outBuf _ inBuf]. codec ifNil: [audioWriter appendSamples: outBuf] ifNotNil: [ counts _ codec encodeFrames: (outBuf size // samplesPerFrame) from: outBuf at: 1 into: compressed at: 1. byteCount _ counts last. byteCount = compressed size ifTrue: [audioWriter appendBytes: compressed] ifFalse: [audioWriter appendBytes: (compressed copyFrom: 1 to: byteCount)]]. samplesRemaining _ samplesRemaining - inBuf monoSampleCount]. "update audio header" audioWriter updateHeaderDataSize. ! ! !StreamingMP3Sound methodsFor: 'private' stamp: 'jm 11/16/2001 15:59'! createMixer "Create a mixed sound consisting of sampled sounds with one sound buffer's worth of samples. The sound has the same sampling rate and number of channels as the MPEG or MP3 file." | channels pan snd | mpegFile ifNil: [^ self error: 'No MPEG or MP3 file']. channels _ mpegFile audioChannels: mpegStreamIndex. streamSamplingRate _ mpegFile audioSampleRate: mpegStreamIndex. mixer _ MixedSound new. 1 to: channels do: [:c | channels = 1 ifTrue: [pan _ 0.5] ifFalse: [pan _ (c - 1) asFloat / (channels - 1)]. snd _ SampledSound samples: (SoundBuffer newMonoSampleCount: 2) "buffer size will be adjusted dynamically" samplingRate: streamSamplingRate. mixer add: snd pan: pan volume: volume]. ! ! !StreamingMP3Sound methodsFor: 'private' stamp: 'jm 11/16/2001 15:59'! loadBuffersForSampleCount: count "Load the sound buffers for all tracks with the next count samples from the MPEG file sound track." | snd buf | 1 to: mixer sounds size do: [:i | snd _ mixer sounds at: i. buf _ snd samples. buf monoSampleCount = count ifFalse: [ buf _ SoundBuffer newMonoSampleCount: count. snd setSamples: buf samplingRate: streamSamplingRate]. i = 1 ifTrue: [ "first channel" mpegFile audioReadBuffer: buf stream: mpegStreamIndex channel: 0] ifFalse: [ "all other channels" mpegFile audioReReadBuffer: buf stream: mpegStreamIndex channel: 0]]. mixer reset. ! ! !StreamingMP3Sound class methodsFor: 'instance creation' stamp: 'jm 11/20/2001 16:35'! onFileNamed: fileName "Answer an instance of me for playing the sound track of the MPEG or MP3 file with the given name. Answer nil the file is not a valid MPEG or MP3 file." | mpegFile | (MPEGFile isFileValidMPEG: fileName) ifFalse: [^ nil]. mpegFile _ MPEGFile openFile: fileName. ^ self new initMPEGFile: mpegFile streamIndex: 0 "assume sound track is in stream 0" ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 10/5/2001 12:09'! boolean "Answer the next boolean value from this (binary) stream." ^ self next ~= 0 ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 10/5/2001 12:11'! boolean: aBoolean "Store the given boolean value on this (binary) stream." self nextPut: (aBoolean ifTrue: [1] ifFalse: [0]). ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 7/16/2001 14:43'! int16 "Answer the next signed, 16-bit integer from this (binary) stream." | n | n _ self next. n _ (n bitShift: 8) + (self next). n >= 16r8000 ifTrue: [n _ n - 16r10000]. ^ n ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 7/16/2001 14:44'! int16: anInteger "Store the given signed, 16-bit integer on this (binary) stream." | n | (anInteger < -16r8000) | (anInteger >= 16r8000) ifTrue: [self error: 'outside 16-bit integer range']. anInteger < 0 ifTrue: [n _ 16r10000 + anInteger] ifFalse: [n _ anInteger]. self nextPut: (n digitAt: 2). self nextPut: (n digitAt: 1). ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 7/16/2001 15:15'! int32 "Answer the next signed, 32-bit integer from this (binary) stream." "Details: As a fast check for negative number, check the high bit of the first digit" | n firstDigit | n _ firstDigit _ self next. n _ (n bitShift: 8) + self next. n _ (n bitShift: 8) + self next. n _ (n bitShift: 8) + self next. firstDigit >= 128 ifTrue: [n _ -16r100000000 + n]. "decode negative 32-bit integer" ^ n ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 7/16/2001 14:46'! int32: anInteger "Store the given signed, 32-bit integer on this (binary) stream." | n | (anInteger < -16r80000000) | (anInteger >= 16r80000000) ifTrue: [self error: 'outside 32-bit integer range']. anInteger < 0 ifTrue: [n _ 16r100000000 + anInteger] ifFalse: [n _ anInteger]. self nextPut: (n digitAt: 4). self nextPut: (n digitAt: 3). self nextPut: (n digitAt: 2). self nextPut: (n digitAt: 1). ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 9/5/2001 07:35'! string "Answer the next string from this (binary) stream." | size | size _ self uint16. ^ (self next: size) asString ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 9/5/2001 12:09'! string: aString "Store the given string on this (binary) stream. The string must contain 65535 or fewer characters." aString size > 16rFFFF ifTrue: [self error: 'string too long for this format']. self uint16: aString size. self nextPutAll: aString asByteArray. ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 07:53'! uint16 "Answer the next unsigned, 16-bit integer from this (binary) stream." | n | n _ self next. n _ (n bitShift: 8) + (self next). ^ n ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 07:53'! uint16: anInteger "Store the given unsigned, 16-bit integer on this (binary) stream." (anInteger < 0) | (anInteger >= 16r10000) ifTrue: [self error: 'outside unsigned 16-bit integer range']. self nextPut: (anInteger digitAt: 2). self nextPut: (anInteger digitAt: 1). ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 08:07'! uint24 "Answer the next unsigned, 24-bit integer from this (binary) stream." | n | n _ self next. n _ (n bitShift: 8) + self next. n _ (n bitShift: 8) + self next. ^ n ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 08:07'! uint24: anInteger "Store the given unsigned, 24-bit integer on this (binary) stream." (anInteger < 0) | (anInteger >= 16r1000000) ifTrue: [self error: 'outside unsigned 24-bit integer range']. self nextPut: (anInteger digitAt: 3). self nextPut: (anInteger digitAt: 2). self nextPut: (anInteger digitAt: 1). ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 07:53'! uint32 "Answer the next unsigned, 32-bit integer from this (binary) stream." | n | n _ self next. n _ (n bitShift: 8) + self next. n _ (n bitShift: 8) + self next. n _ (n bitShift: 8) + self next. ^ n ! ! !PositionableStream methodsFor: 'data get/put' stamp: 'jm 8/20/2001 07:52'! uint32: anInteger "Store the given unsigned, 32-bit integer on this (binary) stream." (anInteger < 0) | (anInteger >= 16r100000000) ifTrue: [self error: 'outside unsigned 32-bit integer range']. self nextPut: (anInteger digitAt: 4). self nextPut: (anInteger digitAt: 3). self nextPut: (anInteger digitAt: 2). self nextPut: (anInteger digitAt: 1). ! ! StreamingMP3Sound class removeSelector: #openFile:! !StreamingMP3Sound class reorganize! ('instance creation' onFileNamed:) ! StreamingMP3Sound removeSelector: #initFileName:! StreamingMP3Sound removeSelector: #initMPEGHandle:streamIndex:! !StreamingMP3Sound reorganize! ('initialization' initMPEGFile:streamIndex:) ('file ops' closeFile mpegFileIsOpen) ('accessing' duration repeat repeat: soundPosition soundPosition: streamSamplingRate volume volume:) ('playing' millisecondsSinceStart playSampleCount:into:startingAt: reset samplesRemaining) ('converting' storeSunAudioOn:compressionType:) ('private' createMixer loadBuffersForSampleCount:) ! !GSMCodec class reorganize! ('instance creation' new) !