[BUG] LoopedSampledSound, PolygonMorph

Webb McDonald vanjulio at cc.gatech.edu
Tue Apr 9 04:50:33 UTC 2002


the class method:
#fromAIFFFileNamed:mergeIfStereo:

is lacking a ^ on final line. so instead the class 'LoopedSampledSound' is
returned instead of an instance.
---------------------
PolygonMorph, I may be abusing.  Within #curveBounds you can see that
curveState is intentionally set to nil to "force recomputation of
curveState" which is done immediately below in #lineSegmentsDo  .
I say I might be abusing polygonMorph because I am using it in such a way
that the #curveBounds is being entered in parallel so curveBounds is being
sent #at:put: when it is reset to nil from above.  I just thought that to
prevent this it would be better to ensure curveState is no longer nil by
adding test for nil before the #at:put: - and jumping to #coefficients if
nil.                                             


~~~~~~~~~~~~~~~~~~~~~~~~~
Webb McDonald
"Laughter means: being schadenfroh,
but with a good conscience."-Nietzsche
~~~~~~~~~~~~~~~~~~~~~~~~~

-------------- next part --------------
'From Squeak3.2alpha of 1 November 2001 [latest update: #4646] on 8 April 2002 at 8:32:51 pm'!
AbstractSound subclass: #LoopedSampledSound
	instanceVariableNames: 'initialCount count releaseCount sampleCountForRelease leftSamples rightSamples originalSamplingRate perceivedPitch gain firstSample lastSample loopEnd scaledLoopLength scaledIndex scaledIndexIncr '
	classVariableNames: 'FloatLoopIndexScaleFactor LoopIndexFractionMask LoopIndexScaleFactor '
	poolDictionaries: ''
	category: 'Sound-Synthesis'!
!LoopedSampledSound commentStamp: '<historical>' prior: 0!
I respresent a sequence of sound samples, often used to record a single note played by a real instrument. I can be pitch-shifted up or down, and can include a looped portion to allow a sound to be sustained indefinitely.
!


!LoopedSampledSound methodsFor: 'initialization' stamp: 'jm 10/14/1998 16:04'!
addReleaseEnvelope
	"Add a simple release envelope to this sound."

	| p env |
	p _ OrderedCollection new.
	p add: 0 at 1.0; add: 10 at 1.0; add: 100 at 1.0; add: 120 at 0.0.
	env _ (VolumeEnvelope points: p loopStart: 2 loopEnd: 3) target: self.
	envelopes size > 0 ifTrue: [  "remove any existing volume envelopes"
		envelopes copy do: [:e |
			(e isKindOf: VolumeEnvelope) ifTrue: [self removeEnvelope: e]]].
	self addEnvelope: env.
! !

!LoopedSampledSound methodsFor: 'initialization' stamp: 'jm 8/18/1998 11:48'!
computeSampleCountForRelease
	"Calculate the number of samples before the end of the note after which looping back will be be disabled. The units of this value, sampleCountForRelease, are samples at the original sampling rate. When playing a specific note, this value is converted to releaseCount, which is number of samples to be computed at the current pitch and sampling rate."
	"Details: For short loops, set the sampleCountForRelease to the loop length plus the number of samples between loopEnd and lastSample. Otherwise, set it to 1/10th of a second worth of samples plus the number of samples between loopEnd and lastSample. In this case, the trailing samples will be played only if the last loop-back occurs within 1/10th of a second of the total note duration, and the note may be shortened by up to 1/10th second. For long loops, this is the best we can do."

	(scaledLoopLength > 0 and: [lastSample > loopEnd])
		ifTrue: [
			sampleCountForRelease _ (lastSample - loopEnd) +
				(self loopLength min: (originalSamplingRate / 10.0)) asInteger]
		ifFalse: [sampleCountForRelease _ 0].

	releaseCount _ sampleCountForRelease.
! !

!LoopedSampledSound methodsFor: 'initialization' stamp: 'jm 5/5/1999 20:59'!
fromAIFFFileNamed: fileName mergeIfStereo: mergeFlag
	"Initialize this sound from the data in the given AIFF file. If mergeFlag is true and the file is stereo, its left and right channels are mixed together to produce a mono sampled sound."

	| aiffFileReader |
	aiffFileReader _ AIFFFileReader new.
	aiffFileReader readFromFile: fileName
		mergeIfStereo: mergeFlag
		skipDataChunk: false.
	aiffFileReader isLooped
		ifTrue: [
			self samples: aiffFileReader leftSamples
				loopEnd: aiffFileReader loopEnd
				loopLength: aiffFileReader loopLength
				pitch: aiffFileReader pitch
				samplingRate: aiffFileReader samplingRate]
		ifFalse: [
			self unloopedSamples: aiffFileReader leftSamples
				pitch: aiffFileReader pitch
				samplingRate: aiffFileReader samplingRate].

	"the following must be done second, since the initialization above sets
	 leftSamples and rightSamples to the same sample data"
	aiffFileReader isStereo
		ifTrue: [rightSamples _ aiffFileReader rightSamples].

	initialCount _ (leftSamples size * self samplingRate) // originalSamplingRate.
	self loudness: 1.0.

	self addReleaseEnvelope.
! !

!LoopedSampledSound methodsFor: 'initialization'!
fromAIFFFileReader: aiffFileReader mergeIfStereo: mergeFlag
	"Initialize this sound from the data in the given AIFF file. If mergeFlag is true and the file is stereo, its left and right channels are mixed together to produce a mono sampled sound."

	aiffFileReader isLooped
		ifTrue: [
			self samples: aiffFileReader leftSamples
				loopEnd: aiffFileReader loopEnd
				loopLength: aiffFileReader loopLength
				pitch: aiffFileReader pitch
				samplingRate: aiffFileReader samplingRate]
		ifFalse: [
			self unloopedSamples: aiffFileReader leftSamples
				pitch: aiffFileReader pitch
				samplingRate: aiffFileReader samplingRate].

	"the following must be done second, since the initialization above sets
	 leftSamples and rightSamples to the same sample data"
	aiffFileReader isStereo
		ifTrue: [rightSamples _ aiffFileReader rightSamples].

	initialCount _ (leftSamples size * self samplingRate) // originalSamplingRate.
	self loudness: 1.0.

	self addReleaseEnvelope.
! !

!LoopedSampledSound methodsFor: 'initialization' stamp: 'jm 8/18/1998 07:43'!
initialize
	"This default initialization creates a loop consisting of a single cycle of a sine wave."
	"(LoopedSampledSound pitch: 440.0 dur: 1.0 loudness: 0.4) play"

	| samples |
	super initialize.
	samples _ FMSound sineTable.
	self samples: samples
		loopEnd: samples size
		loopLength: samples size
		pitch: 1.0
		samplingRate: samples size.
	self addReleaseEnvelope.
	self setPitch: 440.0 dur: 1.0 loudness: 0.5.
! !

!LoopedSampledSound methodsFor: 'initialization' stamp: 'jm 7/9/1999 22:28'!
samples: aSoundBuffer loopEnd: loopEndIndex loopLength: loopSampleCount pitch: perceivedPitchInHz samplingRate: samplingRateInHz
	"Make this sound use the given samples array with a loop of the given length starting at the given index. The loop length may have a fractional part; this is necessary to achieve pitch accuracy for short loops."

	| loopStartIndex |
	super initialize.
	loopStartIndex _ (loopEndIndex - loopSampleCount) truncated + 1.
	((1 <= loopStartIndex) and:
	 [loopStartIndex < loopEndIndex and:
	 [loopEndIndex <= aSoundBuffer size]])
		ifFalse: [self error: 'bad loop parameters'].

	leftSamples _ rightSamples _ aSoundBuffer.
	originalSamplingRate _ samplingRateInHz asFloat.
	perceivedPitch _ perceivedPitchInHz asFloat.
	gain _ 1.0.
	firstSample _ 1.
	lastSample _ leftSamples size.
	lastSample >= (SmallInteger maxVal // LoopIndexScaleFactor) ifTrue: [
		self error: 'cannot handle more than ',
			(SmallInteger maxVal // LoopIndexScaleFactor) printString, ' samples'].
	loopEnd _ loopEndIndex.
	scaledLoopLength _ (loopSampleCount * LoopIndexScaleFactor) asInteger.
	scaledIndexIncr _ (samplingRateInHz * LoopIndexScaleFactor) // self samplingRate.
	self computeSampleCountForRelease.
! !

!LoopedSampledSound methodsFor: 'initialization' stamp: 'jm 7/6/1998 17:09'!
setPitch: pitchNameOrNumber dur: d loudness: vol
	"(LoopedSampledSound pitch: 440.0 dur: 2.5 loudness: 0.4) play"

	super setPitch: pitchNameOrNumber dur: d loudness: vol.
	self pitch: (self nameOrNumberToPitch: pitchNameOrNumber).
	self reset.
! !

!LoopedSampledSound methodsFor: 'initialization' stamp: 'jm 7/9/1999 22:28'!
unloopedSamples: aSoundBuffer pitch: perceivedPitchInHz samplingRate: samplingRateInHz
	"Make this sound play the given samples unlooped. The samples have the given perceived pitch when played at the given sampling rate. By convention, unpitched sounds such as percussion sounds should specify a pitch of nil or 100 Hz."

	super initialize.
	leftSamples _ rightSamples _ aSoundBuffer.
	originalSamplingRate _ samplingRateInHz asFloat.
	perceivedPitchInHz
		ifNil: [perceivedPitch _ 100.0]
		ifNotNil: [perceivedPitch _ perceivedPitchInHz asFloat].
	gain _ 1.0.
	firstSample _ 1.
	lastSample _ leftSamples size.
	lastSample >= (SmallInteger maxVal // LoopIndexScaleFactor) ifTrue: [
		self error: 'cannot handle more than ',
			(SmallInteger maxVal // LoopIndexScaleFactor) printString, ' samples'].
	loopEnd _ leftSamples size.
	scaledLoopLength _ 0.  "zero length means unlooped"
	scaledIndexIncr _ (samplingRateInHz * LoopIndexScaleFactor) // self samplingRate.
	self computeSampleCountForRelease.
! !


!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 5/31/1999 14:09'!
beUnlooped

	scaledLoopLength _ 0.
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/18/1998 07:26'!
duration
	"Answer the duration of this sound in seconds."

	^ initialCount asFloat / self samplingRate asFloat
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 9/11/1998 15:36'!
duration: seconds

	super duration: seconds.
	count _ initialCount _ (seconds * self samplingRate) rounded.
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/18/1998 07:25'!
firstSample

	^ firstSample
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/18/1998 07:25'!
firstSample: aNumber

	firstSample _ (aNumber asInteger max: 1) min: lastSample.
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/3/1998 18:52'!
gain

	^ gain
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/3/1998 18:52'!
gain: aNumber

	gain _ aNumber asFloat.
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/18/1998 07:26'!
isLooped

	^ scaledLoopLength ~= 0.  "zero loop length means unlooped"
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/2/1998 10:14'!
isStereo

	^ leftSamples ~~ rightSamples
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 7/13/1998 11:46'!
leftSamples

	^ leftSamples
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 7/13/1998 11:46'!
leftSamples: aSampleBuffer

	leftSamples _ aSampleBuffer.
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/17/1998 09:35'!
loopEnd

	^ loopEnd
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/2/1998 10:12'!
loopLength

	^ scaledLoopLength / FloatLoopIndexScaleFactor
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 10/14/1998 16:26'!
originalSamplingRate

	^ originalSamplingRate
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 2/2/1999 09:54'!
perceivedPitch

	^ perceivedPitch
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/17/1998 09:08'!
pitch

	^ (scaledIndexIncr asFloat * perceivedPitch * self samplingRate asFloat) /
	  (originalSamplingRate * FloatLoopIndexScaleFactor)
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 8/18/1998 11:38'!
pitch: p

	scaledIndexIncr _
		((p asFloat * originalSamplingRate * FloatLoopIndexScaleFactor) /
		 (perceivedPitch * self samplingRate asFloat)) asInteger.

	sampleCountForRelease > 0
		ifTrue: [releaseCount _ (sampleCountForRelease * LoopIndexScaleFactor) // scaledIndexIncr]
		ifFalse: [releaseCount _ 0].
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 7/13/1998 11:46'!
rightSamples

	^ rightSamples
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 7/13/1998 11:46'!
rightSamples: aSampleBuffer

	rightSamples _ aSampleBuffer.
! !

!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 3/15/1999 08:01'!
samples
	"For compatability with SampledSound. Just return my left channel (which is the only channel if I am mono)."

	^ leftSamples
! !


!LoopedSampledSound methodsFor: 'sound generation' stamp: 'ar 2/3/2001 15:23'!
mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol
	"Play samples from a wave table by stepping a fixed amount through the table on every sample. The table index and increment are scaled to allow fractional increments for greater pitch accuracy.  If a loop length is specified, then the index is looped back when the loopEnd index is reached until count drops below releaseCount. This allows a short sampled sound to be sustained indefinitely."
	"(LoopedSampledSound pitch: 440.0 dur: 5.0 loudness: 0.5) play"

	| lastIndex sampleIndex i s compositeLeftVol compositeRightVol nextSampleIndex m isInStereo rightVal leftVal |
	<primitive:'primitiveMixLoopedSampledSound' module:'SoundGenerationPlugin'>
	self var: #aSoundBuffer declareC: 'short int *aSoundBuffer'.
	self var: #leftSamples declareC: 'short int *leftSamples'.
	self var: #rightSamples declareC: 'short int *rightSamples'.

	isInStereo _ leftSamples ~~ rightSamples.
	compositeLeftVol _ (leftVol * scaledVol) // ScaleFactor.
	compositeRightVol _  (rightVol * scaledVol) // ScaleFactor.

	i _ (2 * startIndex) - 1.
	lastIndex _ (startIndex + n) - 1.
	startIndex to: lastIndex do: [:sliceIndex |
		sampleIndex _ (scaledIndex _ scaledIndex + scaledIndexIncr) // LoopIndexScaleFactor.
		((sampleIndex > loopEnd) and: [count > releaseCount]) ifTrue: [
			"loop back if not within releaseCount of the note end"
			"note: unlooped sounds will have loopEnd = lastSample"
			sampleIndex _ (scaledIndex _ scaledIndex - scaledLoopLength) // LoopIndexScaleFactor].
		(nextSampleIndex _ sampleIndex + 1) > lastSample ifTrue: [
			sampleIndex > lastSample ifTrue: [count _ 0. ^ nil].  "done!!"
			scaledLoopLength = 0
				ifTrue: [nextSampleIndex _ sampleIndex]
				ifFalse: [nextSampleIndex _ ((scaledIndex - scaledLoopLength) // LoopIndexScaleFactor) + 1]].

		m _ scaledIndex bitAnd: LoopIndexFractionMask.
		rightVal _ leftVal _
			(((leftSamples at: sampleIndex) * (LoopIndexScaleFactor - m)) +
			 ((leftSamples at: nextSampleIndex) * m)) // LoopIndexScaleFactor.
		isInStereo ifTrue: [
			rightVal _
				(((rightSamples at: sampleIndex) * (LoopIndexScaleFactor - m)) +
				 ((rightSamples at: nextSampleIndex) * m)) // LoopIndexScaleFactor].

		leftVol > 0 ifTrue: [
			s _ (aSoundBuffer at: i) + ((compositeLeftVol * leftVal) // ScaleFactor).
			s >  32767 ifTrue: [s _  32767].  "clipping!!"
			s < -32767 ifTrue: [s _ -32767].  "clipping!!"
			aSoundBuffer at: i put: s].
		i _ i + 1.
		rightVol > 0 ifTrue: [
			s _ (aSoundBuffer at: i) + ((compositeRightVol * rightVal) // ScaleFactor).
			s >  32767 ifTrue: [s _  32767].  "clipping!!"
			s < -32767 ifTrue: [s _ -32767].  "clipping!!"
			aSoundBuffer at: i put: s].
		i _ i + 1.

		scaledVolIncr ~= 0 ifTrue: [  "update volume envelope if it is changing"
			scaledVol _ scaledVol + scaledVolIncr.
			((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or:
			 [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]])
				ifTrue: [  "reached the limit; stop incrementing"
					scaledVol _ scaledVolLimit.
					scaledVolIncr _ 0].
			compositeLeftVol _ (leftVol * scaledVol) // ScaleFactor.
			compositeRightVol _  (rightVol * scaledVol) // ScaleFactor]].

	count _ count - n.
! !

!LoopedSampledSound methodsFor: 'sound generation' stamp: 'jm 8/17/1998 09:38'!
reset

	super reset.
	count _ initialCount.
	scaledIndex _ firstSample * LoopIndexScaleFactor.
! !

!LoopedSampledSound methodsFor: 'sound generation' stamp: 'jm 8/18/1998 09:31'!
samplesRemaining
	"Answer the number of samples remaining until the end of this sound."

	^ count
! !

!LoopedSampledSound methodsFor: 'sound generation' stamp: 'jm 9/9/1998 21:57'!
stopAfterMSecs: mSecs
	"Terminate this sound this note after the given number of milliseconds."

	count _ (mSecs * self samplingRate) // 1000.
! !


!LoopedSampledSound methodsFor: 'other' stamp: 'jm 8/18/1998 08:19'!
copyDownSampledLowPassFiltering: doFiltering
	"Answer a copy of the receiver at half its sampling rate. The result consumes half the memory space, but has only half the frequency range of the original. If doFiltering is true, the original sound buffers are low-pass filtered before down-sampling. This is slower, but prevents aliasing of any high-frequency components of the original signal. (While it may be possible to avoid low-pass filtering when down-sampling from 44.1 kHz to 22.05 kHz, it is probably essential when going to lower sampling rates.)"

	^ self copy downSampleLowPassFiltering: doFiltering
! !

!LoopedSampledSound methodsFor: 'other' stamp: 'jm 8/18/1998 09:30'!
edit
	"Open a WaveEditor on this sound."

	| loopLen ed |
	loopLen _ scaledLoopLength asFloat / LoopIndexScaleFactor.
	ed _ WaveEditor new
		data: leftSamples;
		samplingRate: originalSamplingRate;
		loopEnd: loopEnd;
		loopLength: loopLen;
		loopCycles: (loopLen / (originalSamplingRate asFloat / perceivedPitch)) rounded.
	ed openInWorld.
! !

!LoopedSampledSound methodsFor: 'other' stamp: 'jm 8/18/1998 07:49'!
fftAt: startIndex
	"Answer the Fast Fourier Transform (FFT) of my samples (only the left channel, if stereo) starting at the given index."

	| availableSamples fftWinSize |
	availableSamples _ (leftSamples size - startIndex) + 1.
	fftWinSize _ 2 raisedTo: (((availableSamples - 1) log: 2) truncated + 1).
	fftWinSize _ fftWinSize min: 4096.
	fftWinSize > availableSamples ifTrue: [fftWinSize _ fftWinSize / 2].
	^ self fftWindowSize: fftWinSize startingAt: startIndex
! !

!LoopedSampledSound methodsFor: 'other' stamp: 'jm 5/29/1999 18:56'!
findStartPointAfter: index
	"Answer the index of the last zero crossing sample before the given index."

	| i |
	i _ index min: lastSample.

	"scan backwards to the last zero-crossing"
	(leftSamples at: i) > 0
		ifTrue: [
			[i > 1 and: [(leftSamples at: i) > 0]] whileTrue: [i _ i - 1]]
		ifFalse: [
			[i > 1 and: [(leftSamples at: i) < 0]] whileTrue: [i _ i - 1]].
	^ i
! !

!LoopedSampledSound methodsFor: 'other' stamp: 'jm 8/18/1998 09:29'!
findStartPointForThreshold: threshold
	"Answer the index of the last zero crossing sample before the first sample whose absolute value (in either the right or left channel) exceeds the given threshold."

	| i |
	i _ self indexOfFirstPointOverThreshold: threshold.
	i >= lastSample ifTrue: [^ self error: 'no sample exceeds the given threshold'].

	"scan backwards to the last zero-crossing"
	(leftSamples at: i) > 0
		ifTrue: [
			[i > 1 and: [(leftSamples at: i) > 0]] whileTrue: [i _ i - 1]]
		ifFalse: [
			[i > 1 and: [(leftSamples at: i) < 0]] whileTrue: [i _ i - 1]].
	^ i
! !

!LoopedSampledSound methodsFor: 'other' stamp: 'jm 8/18/1998 09:26'!
highestSignificantFrequencyAt: startIndex
	"Answer the highest significant frequency in the sample window starting at the given index. The a frequency is considered significant if it's power is at least 1/50th that of the maximum frequency component in the frequency spectrum."

	| fft powerArray threshold indices |
	fft _ self fftAt: startIndex.
	powerArray _ self normalizedResultsFromFFT: fft.
	threshold _ powerArray max / 50.0.
	indices _ (1 to: powerArray size) select: [:i | (powerArray at: i) > threshold].
	^ originalSamplingRate / (fft samplesPerCycleForIndex: indices last)
! !

!LoopedSampledSound methodsFor: 'other' stamp: 'jm 8/17/1998 09:22'!
indexOfFirstPointOverThreshold: threshold
	"Answer the index of the first sample whose absolute value exceeds the given threshold."

	| s |
	leftSamples == rightSamples
		ifTrue: [
			1 to: lastSample do: [:i |
				s _ leftSamples at: i.
				s < 0 ifTrue: [s _ 0 - s].
				s > threshold ifTrue: [^ i]]]
		ifFalse: [
			1 to: lastSample do: [:i |
				s _ leftSamples at: i.
				s < 0 ifTrue: [s _ 0 - s].
				s > threshold ifTrue: [^ i].
				s _ rightSamples at: i.
				s < 0 ifTrue: [s _ 0 - s].
				s > threshold ifTrue: [^ i]]].
	^ lastSample + 1
! !


!LoopedSampledSound methodsFor: 'disk i/o' stamp: 'tk 4/8/1999 12:45'!
comeFullyUpOnReload: smartRefStream
	"Convert my sample buffers from ByteArrays into SampleBuffers after raw loading from a DataStream. Answer myself."

	leftSamples == rightSamples
		ifTrue: [
			leftSamples _ SoundBuffer fromByteArray: self leftSamples.
			rightSamples _ leftSamples]
		ifFalse: [
			leftSamples _ SoundBuffer fromByteArray: self leftSamples.
			rightSamples _ SoundBuffer fromByteArray: self rightSamples].

! !

!LoopedSampledSound methodsFor: 'disk i/o' stamp: 'tk 9/25/2000 12:06'!
objectForDataStream: refStrm
    "Answer an object to store on a data stream, a copy of myself whose SampleBuffers have been converted into ByteArrays."

	refStrm replace: leftSamples with: leftSamples asByteArray.
	refStrm replace: rightSamples with: rightSamples asByteArray.
	"substitution will be made in DataStream nextPut:"
	^ self
! !


!LoopedSampledSound methodsFor: 'private' stamp: 'jm 8/18/1998 08:11'!
downSampleLowPassFiltering: doFiltering
	"Cut my sampling rate in half. Use low-pass filtering (slower) if doFiltering is true."
	"Note: This operation loses information, and modifies the receiver in place."

	| stereo newLoopLength |
	stereo _ self isStereo.
	leftSamples _ leftSamples downSampledLowPassFiltering: doFiltering.
	stereo
		ifTrue: [rightSamples _ rightSamples downSampledLowPassFiltering: doFiltering]
		ifFalse: [rightSamples _ leftSamples].
	originalSamplingRate _ originalSamplingRate / 2.0.
	loopEnd odd
		ifTrue: [newLoopLength _ (self loopLength / 2.0) + 0.5]
		ifFalse: [newLoopLength _ self loopLength / 2.0].
	firstSample _ (firstSample + 1) // 2.
	lastSample _ (lastSample + 1) // 2.
	loopEnd _ (loopEnd + 1) // 2.
	scaledLoopLength _ (newLoopLength * LoopIndexScaleFactor) asInteger.
	scaledIndexIncr _ scaledIndexIncr // 2.
! !

!LoopedSampledSound methodsFor: 'private' stamp: 'jm 8/18/1998 07:48'!
fftWindowSize: windowSize startingAt: startIndex
	"Answer a Fast Fourier Transform (FFT) of the given number of samples starting at the given index (the left channel only, if stereo). The window size will be rounded up to the nearest power of two greater than the requested size. There must be enough samples past the given starting index to accomodate this window size."

	| nu n fft |
	nu _ ((windowSize - 1) log: 2) truncated + 1.
	n _ 2 raisedTo: nu.
	fft _ FFT new nu: nu.
	fft realData: ((startIndex to: startIndex + n - 1) collect: [:i | leftSamples at: i]).
	^ fft transformForward: true.
! !

!LoopedSampledSound methodsFor: 'private' stamp: 'jm 8/16/1998 17:48'!
normalizedResultsFromFFT: fft
	"Answer an array whose size is half of the FFT window size containing power in each frequency band, normalized to the average power over the entire FFT. A value of 10.0 in this array thus means that the power at the corresponding frequences is ten times the average power across the entire FFT."

	| r avg |
	r _ (1 to: fft realData size // 2) collect:
		[:i | ((fft realData at: i) squared + (fft imagData at: i) squared) sqrt].
	avg _ r sum / r size.
	^ r collect: [:v | v / avg].
! !


!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"
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

LoopedSampledSound class
	instanceVariableNames: ''!

!LoopedSampledSound class methodsFor: 'class initialization' stamp: 'jm 8/13/1998 12:54'!
initialize
	"LoopedSampledSound initialize"

	LoopIndexScaleFactor _ 512.
	FloatLoopIndexScaleFactor _ LoopIndexScaleFactor asFloat.
	LoopIndexFractionMask _ LoopIndexScaleFactor - 1.
! !


!LoopedSampledSound class methodsFor: 'instance creation' stamp: 'wxm 4/8/2002 20:28'!
fromAIFFFileNamed: fileName mergeIfStereo: mergeFlag 
	"Initialize this sound from the data in the given AIFF file. If mergeFlag 
	is true and the file is stereo, its left and right channels are mixed 
	together to produce a mono sampled sound."
	| aiffFileReader |
	aiffFileReader _ AIFFFileReader new.
	aiffFileReader
		readFromFile: fileName
		mergeIfStereo: mergeFlag
		skipDataChunk: false.
	^self new fromAIFFFileReader: aiffFileReader mergeIfStereo: mergeFlag! !

!LoopedSampledSound class methodsFor: 'instance creation' stamp: 'jm 8/18/1998 07:40'!
samples: aSoundBuffer loopEnd: loopEndIndex loopLength: loopSampleCount pitch: perceivedPitchInHz samplingRate: samplingRateInHz
	"See the comment in the instance method of this name."

	^ self basicNew
		samples: aSoundBuffer
		loopEnd: loopEndIndex
		loopLength: loopSampleCount
		pitch: perceivedPitchInHz
		samplingRate: samplingRateInHz
! !

!LoopedSampledSound class methodsFor: 'instance creation' stamp: 'jm 8/18/1998 07:41'!
unloopedSamples: aSoundBuffer pitch: perceivedPitchInHz samplingRate: samplingRateInHz
	"See the comment in the instance method of this name."

	^ self basicNew
		unloopedSamples: aSoundBuffer
		pitch: perceivedPitchInHz
		samplingRate: samplingRateInHz
! !


LoopedSampledSound initialize!
?


More information about the Squeak-dev mailing list