'From R&DSqueak2.8 of 6 June 2001 [latest update: #42] on 17 December 2001 at 8:42:32 am'! "Change Set: soundSaving-jm Date: 16 December 2001 Author: John Maloney Juan Manuel introduced storeWAVOnFileNamed:, which allowed any sound, including a MIDI ScorePlayer to be stored as WAV audio file. This changeset extends that facility to allow saving sounds as AIFF or Sun audio files as well. In addition, several optimizations were added: 1. SampledSounds and LoopedSampledSounds store their sample buffers directly when possible 2. writes sound buffers directly to a filestream in the appropriate endianness Menu commands allow one to store audio files in any of these formats from a ScorePlayerMorph. Note: It is a little quicker to store WAV files on Windows and AIFF files on Macs, since that avoids a byte reversal. " ! !AbstractSound methodsFor: 'accessing' stamp: 'jm 12/16/2001 22:34'! isStereo "Answer true if this sound has distinct left and right channels. (Every sound plays into a stereo sample buffer, but most sounds, which produce exactly the same samples on both channels, are not stereo.)" ^ false ! ! !AbstractSound methodsFor: 'sampling rates' stamp: 'jm 12/16/2001 13:14'! originalSamplingRate "For sampled sounds, answer the sampling rate used to record the stored samples. For other sounds, this is the same as the playback sampling rate." ^ SoundPlayer samplingRate ! ! !AbstractSound methodsFor: 'conversion' stamp: 'jm 12/16/2001 13:26'! asSampledSound "Answer a SampledSound containing my samples. If the receiver is some kind of sampled sound, the resulting SampledSound will have the same original sampling rate as the receiver." ^ SampledSound samples: self samples samplingRate: self originalSamplingRate ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 12/16/2001 13:22'! samples "Answer a monophonic sample buffer containing my samples. The left and write channels are merged." "Warning: This may require a lot of memory!!" ^ (self computeSamplesForSeconds: self duration) mergeStereo ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 12/16/2001 13:24'! viewSamples "Open a WaveEditor on my samples." WaveEditor openOn: self samples. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 21:51'! storeAIFFOnFileNamed: fileName "Store this sound as a AIFF file of the given name." | f | f _ (FileStream fileNamed: fileName) binary. self storeAIFFSamplesOn: f. f close. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 22:31'! storeAIFFSamplesOn: aBinaryStream "Store this sound as a 16-bit AIFF file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound." | samplesToStore channelCount dataByteCount | samplesToStore _ (self duration * self samplingRate) ceiling. channelCount _ self isStereo ifTrue: [2] ifFalse: [1]. dataByteCount _ samplesToStore * channelCount * 2. "write AIFF file header:" aBinaryStream nextPutAll: 'FORM' asByteArray. aBinaryStream nextInt32Put: ((7 * 4) + 18) + dataByteCount. aBinaryStream nextPutAll: 'AIFF' asByteArray. aBinaryStream nextPutAll: 'COMM' asByteArray. aBinaryStream nextInt32Put: 18. aBinaryStream nextNumber: 2 put: channelCount. aBinaryStream nextInt32Put: samplesToStore. aBinaryStream nextNumber: 2 put: 16. "bits/sample" self storeExtendedFloat: self samplingRate on: aBinaryStream. aBinaryStream nextPutAll: 'SSND' asByteArray. aBinaryStream nextInt32Put: dataByteCount + 8. aBinaryStream nextInt32Put: 0. aBinaryStream nextInt32Put: 0. "write data:" self storeSampleCount: samplesToStore bigEndian: true on: aBinaryStream. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/17/2001 08:36'! storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files). If self isStereo is true, both channels are stored, creating a stereo file. Otherwise, only the left channel is stored, creating a mono file." | bufSize stereoBuffer reverseBytes remaining out | self reset. bufSize _ (2 * self samplingRate rounded) min: samplesToStore. "two second buffer" stereoBuffer _ SoundBuffer newStereoSampleCount: bufSize. reverseBytes _ bigEndianFlag ~= (Smalltalk endianness = #big). 'Storing audio...' displayProgressAt: Sensor cursorPoint from: 0 to: samplesToStore during: [:bar | remaining _ samplesToStore. [remaining > 0] whileTrue: [ bar value: samplesToStore - remaining. stereoBuffer primFill: 0. "clear the buffer" self playSampleCount: (bufSize min: remaining) into: stereoBuffer startingAt: 1. self isStereo ifTrue: [out _ stereoBuffer] ifFalse: [out _ stereoBuffer extractLeftChannel]. reverseBytes ifTrue: [out reverseEndianness]. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization for files: write sound buffer directly to file" aBinaryStream next: (out size // 2) putAll: out startingAt: 1] "size in words" ifFalse: [ "for non-file streams:" 1 to: out monoSampleCount do: [:i | aBinaryStream int16: (out at: i)]]. remaining _ remaining - bufSize]]. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 21:47'! storeSunAudioOnFileNamed: fileName "Store this sound as an uncompressed Sun audio file of the given name." | f | f _ (FileStream fileNamed: fileName) binary. self storeSunAudioSamplesOn: f. f close. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 22:32'! storeSunAudioSamplesOn: aBinaryStream "Store this sound as a 16-bit Sun audio file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound." | samplesToStore channelCount dataByteCount | samplesToStore _ (self duration * self samplingRate) ceiling. channelCount _ self isStereo ifTrue: [2] ifFalse: [1]. dataByteCount _ samplesToStore * channelCount * 2. "write Sun audio file header" channelCount _ self isStereo ifTrue: [2] ifFalse: [1]. aBinaryStream nextPutAll: '.snd' asByteArray. aBinaryStream uint32: 24. "header size in bytes" aBinaryStream uint32: dataByteCount. aBinaryStream uint32: 3. "format: 16-bit linear" aBinaryStream uint32: self samplingRate truncated. aBinaryStream uint32: channelCount. "write data:" self storeSampleCount: samplesToStore bigEndian: true on: aBinaryStream. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 20:03'! storeWAVOnFileNamed: fileName "Store this sound as a 16-bit Windows WAV file of the given name." | f | f _ (FileStream fileNamed: fileName) binary. self storeWAVSamplesOn: f. f close. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 22:32'! storeWAVSamplesOn: aBinaryStream "Store this sound as a 16-bit Windows WAV file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound." | samplesToStore channelCount dataByteCount samplesPerSec bytesPerSec | samplesToStore _ (self duration * self samplingRate) ceiling. channelCount _ self isStereo ifTrue: [2] ifFalse: [1]. dataByteCount _ samplesToStore * channelCount * 2. samplesPerSec _ self samplingRate rounded. bytesPerSec _ samplesPerSec * channelCount * 2. "file header" aBinaryStream nextPutAll: 'RIFF' asByteArray; nextLittleEndianNumber: 4 put: dataByteCount + 36; "total length of all chunks" nextPutAll: 'WAVE' asByteArray. "format chunk" aBinaryStream nextPutAll: 'fmt ' asByteArray; nextLittleEndianNumber: 4 put: 16; "length of this chunk" nextLittleEndianNumber: 2 put: 1; "format tag" nextLittleEndianNumber: 2 put: channelCount; nextLittleEndianNumber: 4 put: samplesPerSec; nextLittleEndianNumber: 4 put: bytesPerSec; nextLittleEndianNumber: 2 put: 4; "alignment" nextLittleEndianNumber: 2 put: 16. "bits per sample" "data chunk" aBinaryStream nextPutAll: 'data' asByteArray; nextLittleEndianNumber: 4 put: dataByteCount. "length of this chunk" self storeSampleCount: samplesToStore bigEndian: false on: aBinaryStream. ! ! !LoopedSampledSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 20:36'! storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files)." | reverseBytes | (self isStereo or: [self samplingRate ~= originalSamplingRate]) ifTrue: [ ^ super storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream]. "optimization: if I'm not stereo and sampling rates match, just store my buffer" reverseBytes _ bigEndianFlag ~= (Smalltalk endianness = #big). reverseBytes ifTrue: [leftSamples reverseEndianness]. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization for files: write sound buffer directly to file" aBinaryStream next: (leftSamples size // 2) putAll: leftSamples startingAt: 1] "size in words" ifFalse: [ "for non-file streams:" 1 to: leftSamples monoSampleCount do: [:i | aBinaryStream int16: (leftSamples at: i)]]. reverseBytes ifTrue: [leftSamples reverseEndianness]. "restore to original endianness" ! ! !MixedSound methodsFor: 'accessing' stamp: 'jm 12/16/2001 20:23'! isStereo ^ true ! ! !SampledSound methodsFor: 'file i/o' stamp: 'jm 12/16/2001 21:13'! storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files)." | reverseBytes | self samplingRate ~= originalSamplingRate ifTrue: [ ^ super storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream]. "optimization: if sampling rates match, just store my buffer" reverseBytes _ bigEndianFlag ~= (Smalltalk endianness = #big). reverseBytes ifTrue: [samples reverseEndianness]. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization for files: write sound buffer directly to file" aBinaryStream next: (samples size // 2) putAll: samples startingAt: 1] "size in words" ifFalse: [ "for non-file streams:" 1 to: samples monoSampleCount do: [:i | aBinaryStream int16: (samples at: i)]]. reverseBytes ifTrue: [samples reverseEndianness]. "restore to original endianness" ! ! !ScorePlayer methodsFor: 'accessing' stamp: 'jm 12/16/2001 20:20'! isStereo ^ true ! ! !ScorePlayerMorph methodsFor: 'menu' stamp: 'jm 12/17/2001 09:02'! invokeMenu "Invoke a menu of additonal functions for this ScorePlayer." | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu add: 'open a MIDI file' action: #openMIDIFile. aMenu addList: #( - ('save as AIFF file' saveAsAIFF) ('save as WAV file' saveAsWAV) ('save as Sun AU file' saveAsSunAudio) -). aMenu add: 'reload instruments' target: AbstractSound selector: #updateScorePlayers. aMenu addLine. scorePlayer midiPort ifNil: [ aMenu add: 'play via MIDI' action: #openMIDIPort] ifNotNil: [ aMenu add: 'play via built in synth' action: #closeMIDIPort. aMenu add: 'new MIDI controller' action: #makeMIDIController:]. aMenu addLine. aMenu add: 'make a pause marker' action: #makeAPauseEvent:. aMenu popUpInWorld: self world.! ! !ScorePlayerMorph methodsFor: 'menu' stamp: 'jm 12/17/2001 08:14'! saveAsAIFF "Create a stereo AIFF audio file with the result of performing my score." | fileName | fileName _ FillInTheBlank request: 'New file name?'. fileName size = 0 ifTrue: [^ self]. (fileName asLowercase endsWith: '.aif') ifFalse: [ fileName _ fileName, '.aif']. scorePlayer storeAIFFOnFileNamed: fileName. ! ! !ScorePlayerMorph methodsFor: 'menu' stamp: 'jm 12/17/2001 08:16'! saveAsSunAudio "Create a stereo Sun audio file with the result of performing my score." | fileName | fileName _ FillInTheBlank request: 'New file name?'. fileName size = 0 ifTrue: [^ self]. (fileName asLowercase endsWith: '.au') ifFalse: [ fileName _ fileName, '.au']. scorePlayer storeSunAudioOnFileNamed: fileName. ! ! !ScorePlayerMorph methodsFor: 'menu' stamp: 'jm 12/17/2001 08:14'! saveAsWAV "Create a stereo WAV audio file with the result of performing my score." | fileName | fileName _ FillInTheBlank request: 'New file name?'. fileName size = 0 ifTrue: [^ self]. (fileName asLowercase endsWith: '.wav') ifFalse: [ fileName _ fileName, '.wav']. scorePlayer storeWAVOnFileNamed: fileName. ! ! !SoundBuffer methodsFor: 'utilities' stamp: 'jm 12/16/2001 21:22'! saveAsAIFFFileSamplingRate: rate on: aBinaryStream "Store this mono sound buffer in AIFF file format with the given sampling rate on the given stream." | sampleCount s swapBytes | sampleCount _ self monoSampleCount. aBinaryStream nextPutAll: 'FORM' asByteArray. aBinaryStream nextInt32Put: (2 * sampleCount) + ((7 * 4) + 18). aBinaryStream nextPutAll: 'AIFF' asByteArray. aBinaryStream nextPutAll: 'COMM' asByteArray. aBinaryStream nextInt32Put: 18. aBinaryStream nextNumber: 2 put: 1. "channels" aBinaryStream nextInt32Put: sampleCount. aBinaryStream nextNumber: 2 put: 16. "bits/sample" self storeExtendedFloat: rate on: aBinaryStream. aBinaryStream nextPutAll: 'SSND' asByteArray. aBinaryStream nextInt32Put: (2 * sampleCount) + 8. aBinaryStream nextInt32Put: 0. aBinaryStream nextInt32Put: 0. (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ "optimization: write sound buffer directly to file" swapBytes _ Smalltalk endianness == #little. swapBytes ifTrue: [self reverseEndianness]. "make big endian" aBinaryStream next: (self size // 2) putAll: self startingAt: 1. "size in words" swapBytes ifTrue: [self reverseEndianness]. "revert to little endian" ^ self]. 1 to: sampleCount do: [:i | s _ self at: i. aBinaryStream nextPut: ((s bitShift: -8) bitAnd: 16rFF). aBinaryStream nextPut: (s bitAnd: 16rFF)]. ! ! !SunAudioFileWriter class methodsFor: 'sound storing' stamp: 'jm 12/16/2001 21:37'! storeSampledSound: 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. ! ! SunAudioFileWriter class removeSelector: #storeSound:onFileNamed:compressionType:! !MixedSound reorganize! ('initialization' initialize) ('accessing' duration isStereo sounds) ('sound generation' doControl mixSampleCount:into:startingAt:leftVol:rightVol: reset samplesRemaining stopGracefully) ('composition' + add: add:pan: add:pan:volume:) ('copying' copy copySounds) ! AbstractSound removeSelector: #storeAIFFSamples:samplingRate:on:! AbstractSound removeSelector: #storeSunAudioOnFileNamed:compressionType:! AbstractSound removeSelector: #storeWAVSamplesSamplingRate:on:! !AbstractSound reorganize! ('initialization' duration: initialize loudness: nameOrNumberToPitch: setPitch:dur:loudness: soundForMidiKey:dur:loudness: soundForPitch:dur:loudness:) ('accessing' isStereo) ('sampling rates' controlRate originalSamplingRate samplingRate) ('copying' copy copyEnvelopes sounds) ('conversion' asSampledSound) ('envelopes' addEnvelope: envelopes removeAllEnvelopes removeEnvelope:) ('volume' adjustVolumeTo:overMSecs: initialVolume: loudness volumeEnvelopeScaledTo:) ('playing' computeSamplesForSeconds: isPlaying millisecondsSinceStart pause play playAndWaitUntilDone playChromaticRunFrom:to: playSampleCount:into:startingAt: playSilently playSilentlyUntil: resumePlaying samples viewSamples) ('sound generation' doControl internalizeModulationAndRatio mixSampleCount:into:startingAt:leftVol:rightVol: reset samplesRemaining stopAfterMSecs: stopGracefully storeSample:in:at:leftVol:rightVol: updateVolume) ('composition' + , asSound delayedBy:) ('file i/o' storeAIFFOnFileNamed: storeAIFFSamplesOn: storeExtendedFloat:on: storeSampleCount:bigEndian:on: storeSunAudioOnFileNamed: storeSunAudioSamplesOn: storeWAVOnFileNamed: storeWAVSamplesOn:) !