'From Squeak3.0 of 4 February 2001 [latest update: #3414] on 4 February 2001 at 1:28:53 am'! SoundCodec subclass: #ADPCMCodec instanceVariableNames: 'predicted index deltaSignMask deltaValueMask deltaValueHighBit frameSizeMask currentByte bitPosition byteIndex encodedBytes samples rightSamples sampleIndex bitsPerSample stepSizeTable indexTable ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! !ADPCMCodec commentStamp: '' prior: 0! This is a simple ADPCM (adapative delta pulse code modulation) codec. This is a general audio codec that compresses speech, music, or sound effects equally well, and works at any sampling rate (i.e., it contains no frequency-sensitive filters). It compresses 16-bit sample data down to 5, 4, 3, or 2 bits per sample, with lower fidelity and increased noise at the lowest bit rates. Although it does not deliver state-of-the-art compressions, the alorithm is small, simple, and extremely fast, since the encode/decode primitives have been translated into C primitives. This codec will also encode and decode all Flash .swf file compressed sound formats, both mono and stereo. (Note: stereo Flash compression is not yet implemented, but stereo decompression works.) ! !ADPCMCodec methodsFor: 'bit streaming' stamp: 'jm 3/28/1999 16:24'! nextBits: n "Answer the next n bits of my bit stream as an unsigned integer." | result remaining shift | self inline: true. result _ 0. remaining _ n. [true] whileTrue: [ shift _ remaining - bitPosition. result _ result + (currentByte bitShift: shift). shift > 0 ifTrue: [ "consumed currentByte buffer; fetch next byte" remaining _ remaining - bitPosition. currentByte _ (encodedBytes at: (byteIndex _ byteIndex + 1)). bitPosition _ 8] ifFalse: [ "still some bits left in currentByte buffer" bitPosition _ bitPosition - remaining. "mask out the consumed bits:" currentByte _ currentByte bitAnd: (255 bitShift: (bitPosition - 8)). ^ result]]. ! ! !ADPCMCodec methodsFor: 'bit streaming' stamp: 'jm 3/28/1999 20:21'! nextBits: n put: anInteger "Write the next n bits to my bit stream." | buf bufBits bitsAvailable shift | self inline: true. buf _ anInteger. bufBits _ n. [true] whileTrue: [ bitsAvailable _ 8 - bitPosition. shift _ bitsAvailable - bufBits. "either left or right shift" "append high bits of buf to end of currentByte:" currentByte _ currentByte + (buf bitShift: shift). shift < 0 ifTrue: [ "currentByte buffer filled; output it" encodedBytes at: (byteIndex _ byteIndex + 1) put: currentByte. bitPosition _ 0. currentByte _ 0. "clear saved high bits of buf:" buf _ buf bitAnd: (1 bitShift: 0 - shift) - 1. bufBits _ bufBits - bitsAvailable] ifFalse: [ "still some bits available in currentByte buffer" bitPosition _ bitPosition + bufBits. ^ self]]. ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/27/1999 11:21'! bytesPerEncodedFrame "Answer the number of bytes required to hold one frame of compressed sound data." "Note: When used as a normal codec, the frame size is always 8 samples which results in (8 * bitsPerSample) / 8 = bitsPerSample bytes." ^ bitsPerSample ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 7/2/1999 13:29'! compressAndDecompress: aSound "Compress and decompress the given sound. Overridden to use same bits per sample for both compressing and decompressing." | compressed decoder | compressed _ self compressSound: aSound. decoder _ self class new initializeForBitsPerSample: bitsPerSample samplesPerFrame: 0. ^ decoder decompressSound: compressed ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 15:37'! decodeFrames: frameCount from: srcByteArray at: srcIndex into: dstSoundBuffer at: dstIndex "Decode the given number of monophonic frames starting at the given index in the given ByteArray of compressed sound data and storing the decoded samples into the given SoundBuffer starting at the given destination index. Answer a pair containing the number of bytes of compressed data consumed and the number of decompressed samples produced." "Note: Assume that the sender has ensured that the given number of frames will not exhaust either the source or destination buffers." encodedBytes _ srcByteArray. byteIndex _ srcIndex - 1. bitPosition _ 0. currentByte _ 0. samples _ dstSoundBuffer. sampleIndex _ dstIndex - 1. self privateDecodeMono: (frameCount * self samplesPerFrame). ^ Array with: (byteIndex - (srcIndex - 1)) with: (sampleIndex - (dstIndex - 1)) ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 15:28'! encodeFrames: frameCount from: srcSoundBuffer at: srcIndex into: dstByteArray at: dstIndex "Encode the given number of frames starting at the given index in the given monophonic SoundBuffer and storing the encoded sound data into the given ByteArray starting at the given destination index. Encode only as many complete frames as will fit into the destination. Answer a pair containing the number of samples consumed and the number of bytes of compressed data produced." "Note: Assume that the sender has ensured that the given number of frames will not exhaust either the source or destination buffers." samples _ srcSoundBuffer. sampleIndex _ srcIndex - 1. encodedBytes _ dstByteArray. byteIndex _ dstIndex - 1. bitPosition _ 0. currentByte _ 0. self privateEncodeMono: (frameCount * self samplesPerFrame). ^ Array with: frameCount with: (byteIndex - (dstIndex - 1)) ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 20:12'! resetForMono "Reset my encoding and decoding state for mono." predicted _ 0. index _ 0. ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/28/1999 20:12'! resetForStereo "Reset my encoding and decoding state for stereo." "keep state as SoundBuffers to allow fast access from primitive" predicted _ SoundBuffer new: 2. index _ SoundBuffer new: 2. ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 3/27/1999 08:34'! samplesPerFrame "Answer the number of sound samples per compression frame." frameSizeMask > 0 ifTrue: [^ frameSizeMask + 1]. ^ 8 "frame size when there are no running headers" ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/28/1999 06:26'! decode: aByteArray bitsPerSample: bits ^ self decode: aByteArray sampleCount: (aByteArray size * 8) // bits bitsPerSample: bits frameSize: 0 stereo: false ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/28/1999 15:57'! decode: aByteArray sampleCount: count bitsPerSample: bits frameSize: frameSize stereo: stereoFlag self initializeForBitsPerSample: bits samplesPerFrame: frameSize. encodedBytes _ aByteArray. byteIndex _ 0. bitPosition _ 0. currentByte _ 0. stereoFlag ifTrue: [ self resetForStereo. samples _ SoundBuffer newMonoSampleCount: count. rightSamples _ SoundBuffer newMonoSampleCount: count. sampleIndex _ 0. self privateDecodeStereo: count. ^ Array with: samples with: rightSamples] ifFalse: [ samples _ SoundBuffer newMonoSampleCount: count. sampleIndex _ 0. self privateDecodeMono: count. ^ samples] ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/30/1999 08:56'! decodeFlash: aByteArray sampleCount: sampleCount stereo: stereoFlag | bits | encodedBytes _ aByteArray. byteIndex _ 0. bitPosition _ 0. currentByte _ 0. bits _ 2 + (self nextBits: 2). "bits per sample" self initializeForBitsPerSample: bits samplesPerFrame: 4096. stereoFlag ifTrue: [ self resetForStereo. samples _ SoundBuffer newMonoSampleCount: sampleCount. rightSamples _ SoundBuffer newMonoSampleCount: sampleCount. sampleIndex _ 0. self privateDecodeStereo: sampleCount. ^ Array with: samples with: rightSamples] ifFalse: [ samples _ SoundBuffer newMonoSampleCount: sampleCount. sampleIndex _ 0. self privateDecodeMono: sampleCount. ^ Array with: samples]. ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/28/1999 08:59'! encode: aSoundBuffer bitsPerSample: bits ^ self encodeLeft: aSoundBuffer right: nil bitsPerSample: bits frameSize: 0 forFlash: false ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/28/1999 08:58'! encodeFlashLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits ^ self encodeLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits frameSize: 4096 forFlash: true ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/28/1999 09:17'! 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. 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 methodsFor: 'as yet unclassified' stamp: 'jm 3/27/1999 12:14'! headerBitsForSampleCount: sampleCount stereoFlag: stereoFlag "Answer the number of extra header bits required for the given number of samples. This will be zero if I am not using frame headers." | frameCount bitsPerHeader | frameSizeMask = 0 ifTrue: [^ 0]. frameCount _ (sampleCount / self samplesPerFrame) ceiling. bitsPerHeader _ 16 + 6. stereoFlag ifTrue: [bitsPerHeader _ 2 * bitsPerHeader]. ^ frameCount * bitsPerHeader ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/28/1999 16:08'! indexForDeltaFrom: thisSample to: nextSample "Answer the best index to use for the difference between the given samples." "Details: Scan stepSizeTable for the first entry >= the absolute value of the difference between sample values. Since indexes are zero-based, the index used during decoding will be the one in the following stepSizeTable entry. Since the index field of a Flash frame header is only six bits, the maximum index value is 63." "Note: Since there does not appear to be any documentation of how Flash acutally computes the indices used in its frame headers, this algorithm was guessed by reverse-engineering the Flash ADPCM decoder." | diff bestIndex | self inline: true. diff _ nextSample - thisSample. diff < 0 ifTrue: [diff _ 0 - diff]. bestIndex _ 63. 1 to: 62 do: [:j | bestIndex = 63 ifTrue: [ (stepSizeTable at: j) >= diff ifTrue: [bestIndex _ j]]]. ^ bestIndex ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'jm 3/28/1999 20:48'! initializeForBitsPerSample: sampleBits samplesPerFrame: frameSize self resetForMono. stepSizeTable _ #(7 8 9 10 11 12 13 14 16 17 19 21 23 25 28 31 34 37 41 45 50 55 60 66 73 80 88 97 107 118 130 143 157 173 190 209 230 253 279 307 337 371 408 449 494 544 598 658 724 796 876 963 1060 1166 1282 1411 1552 1707 1878 2066 2272 2499 2749 3024 3327 3660 4026 4428 4871 5358 5894 6484 7132 7845 8630 9493 10442 11487 12635 13899 15289 16818 18500 20350 22385 24623 27086 29794 32767). indexTable _ nil. sampleBits = 2 ifTrue: [ indexTable _ #(-1 2)]. sampleBits = 3 ifTrue: [ indexTable _ #(-1 -1 2 4)]. sampleBits = 4 ifTrue: [ indexTable _ #(-1 -1 -1 -1 2 4 6 8)]. sampleBits = 5 ifTrue: [ indexTable _ #(-1 -1 -1 -1 -1 -1 -1 -1 1 2 4 6 8 10 13 16)]. indexTable ifNil: [self error: 'unimplemented bits/sample']. bitsPerSample _ sampleBits. deltaSignMask _ 1 bitShift: bitsPerSample - 1. deltaValueMask _ deltaSignMask - 1. deltaValueHighBit _ deltaSignMask / 2. frameSize <= 1 ifTrue: [frameSizeMask _ 0] ifFalse: [ (frameSize = (1 bitShift: frameSize highBit - 1)) ifFalse: [self error: 'frameSize must be a power of two']. frameSizeMask _ frameSize - 1]. "keep as SoundBuffer to allow fast access from primitive" indexTable _ SoundBuffer fromArray: indexTable. stepSizeTable _ SoundBuffer fromArray: stepSizeTable. ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'ar 2/3/2001 15:50'! privateDecodeMono: count | delta step predictedDelta bit | self var: #stepSizeTable declareC: 'short int *stepSizeTable'. self var: #indexTable declareC: 'short int *indexTable'. self var: #samples declareC: 'short int *samples'. self var: #encodedBytes declareC: 'unsigned char *encodedBytes'. 1 to: count do: [:i | (i bitAnd: frameSizeMask) = 1 ifTrue: [ "start of frame; read frame header" predicted _ self nextBits: 16. predicted > 32767 ifTrue: [predicted _ predicted - 65536]. index _ self nextBits: 6. samples at: (sampleIndex _ sampleIndex + 1) put: predicted] ifFalse: [ delta _ self nextBits: bitsPerSample. step _ stepSizeTable at: index + 1. predictedDelta _ 0. bit _ deltaValueHighBit. [bit > 0] whileTrue: [ (delta bitAnd: bit) > 0 ifTrue: [predictedDelta _ predictedDelta + step]. step _ step bitShift: -1. bit _ bit bitShift: -1]. predictedDelta _ predictedDelta + step. (delta bitAnd: deltaSignMask) > 0 ifTrue: [predicted _ predicted - predictedDelta] ifFalse: [predicted _ predicted + predictedDelta]. predicted > 32767 ifTrue: [predicted _ 32767] ifFalse: [predicted < -32768 ifTrue: [predicted _ -32768]]. index _ index + (indexTable at: (delta bitAnd: deltaValueMask) + 1). index < 0 ifTrue: [index _ 0] ifFalse: [index > 88 ifTrue: [index _ 88]]. samples at: (sampleIndex _ sampleIndex + 1) put: predicted]]. ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'ar 2/3/2001 15:50'! privateDecodeStereo: count | predictedLeft predictedRight indexLeft indexRight deltaLeft deltaRight stepLeft stepRight predictedDeltaLeft predictedDeltaRight bit | self var: #stepSizeTable declareC: 'short int *stepSizeTable'. self var: #indexTable declareC: 'short int *indexTable'. self var: #samples declareC: 'short int *samples'. self var: #encodedBytes declareC: 'unsigned char *encodedBytes'. self var: #rightSamples declareC: 'short int *rightSamples'. self var: #predicted declareC: 'short int *predicted'. self var: #index declareC: 'short int *index'. "make local copies of decoder state variables" predictedLeft _ predicted at: 1. predictedRight _ predicted at: 2. indexLeft _ index at: 1. indexRight _ index at: 2. 1 to: count do: [:i | (i bitAnd: frameSizeMask) = 1 ifTrue: [ "start of frame; read frame header" predictedLeft _ self nextBits: 16. indexLeft _ self nextBits: 6. predictedRight _ self nextBits: 16. indexRight _ self nextBits: 6. predictedLeft > 32767 ifTrue: [predictedLeft _ predictedLeft - 65536]. predictedRight > 32767 ifTrue: [predictedRight _ predictedRight - 65536]. samples at: (sampleIndex _ sampleIndex + 1) put: predictedLeft. rightSamples at: sampleIndex put: predictedRight] ifFalse: [ deltaLeft _ self nextBits: bitsPerSample. deltaRight _ self nextBits: bitsPerSample. stepLeft _ stepSizeTable at: indexLeft + 1. stepRight _ stepSizeTable at: indexRight + 1. predictedDeltaLeft _ predictedDeltaRight _ 0. bit _ deltaValueHighBit. [bit > 0] whileTrue: [ (deltaLeft bitAnd: bit) > 0 ifTrue: [ predictedDeltaLeft _ predictedDeltaLeft + stepLeft]. (deltaRight bitAnd: bit) > 0 ifTrue: [ predictedDeltaRight _ predictedDeltaRight + stepRight]. stepLeft _ stepLeft bitShift: -1. stepRight _ stepRight bitShift: -1. bit _ bit bitShift: -1]. predictedDeltaLeft _ predictedDeltaLeft + stepLeft. predictedDeltaRight _ predictedDeltaRight + stepRight. (deltaLeft bitAnd: deltaSignMask) > 0 ifTrue: [predictedLeft _ predictedLeft - predictedDeltaLeft] ifFalse: [predictedLeft _ predictedLeft + predictedDeltaLeft]. (deltaRight bitAnd: deltaSignMask) > 0 ifTrue: [predictedRight _ predictedRight - predictedDeltaRight] ifFalse: [predictedRight _ predictedRight + predictedDeltaRight]. predictedLeft > 32767 ifTrue: [predictedLeft _ 32767] ifFalse: [predictedLeft < -32768 ifTrue: [predictedLeft _ -32768]]. predictedRight > 32767 ifTrue: [predictedRight _ 32767] ifFalse: [predictedRight < -32768 ifTrue: [predictedRight _ -32768]]. indexLeft _ indexLeft + (indexTable at: (deltaLeft bitAnd: deltaValueMask) + 1). indexLeft < 0 ifTrue: [indexLeft _ 0] ifFalse: [indexLeft > 88 ifTrue: [indexLeft _ 88]]. indexRight _ indexRight + (indexTable at: (deltaRight bitAnd: deltaValueMask) + 1). indexRight < 0 ifTrue: [indexRight _ 0] ifFalse: [indexRight > 88 ifTrue: [indexRight _ 88]]. samples at: (sampleIndex _ sampleIndex + 1) put: predictedLeft. rightSamples at: sampleIndex put: predictedRight]]. "save local copies of decoder state variables" predicted at: 1 put: predictedLeft. predicted at: 2 put: predictedRight. index at: 1 put: indexLeft. index at: 2 put: indexRight. ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'ar 2/3/2001 15:51'! privateEncodeMono: count | step sign diff delta predictedDelta bit p | self var: #stepSizeTable declareC: 'short int *stepSizeTable'. self var: #indexTable declareC: 'short int *indexTable'. self var: #samples declareC: 'short int *samples'. self var: #encodedBytes declareC: 'unsigned char *encodedBytes'. step _ stepSizeTable at: 1. 1 to: count do: [:i | (i bitAnd: frameSizeMask) = 1 ifTrue: [ predicted _ samples at: (sampleIndex _ sampleIndex + 1). (p _ predicted) < 0 ifTrue: [p _ p + 65536]. self nextBits: 16 put: p. i < count ifTrue: [ index _ self indexForDeltaFrom: predicted to: (samples at: sampleIndex + 1)]. self nextBits: 6 put: index. ] ifFalse: [ "compute sign and magnitude of difference from the predicted sample" sign _ 0. diff _ (samples at: (sampleIndex _ sampleIndex + 1)) - predicted. diff < 0 ifTrue: [ sign _ deltaSignMask. diff _ 0 - diff]. "Compute encoded delta and the difference that this will cause in the predicted sample value during decoding. Note that this code approximates: delta _ (4 * diff) / step. predictedDelta _ ((delta + 0.5) * step) / 4; but in the shift step bits are dropped. Thus, even if you have fast mul/div hardware you cannot use it since you would get slightly different bits what than the algorithm defines." delta _ 0. predictedDelta _ 0. bit _ deltaValueHighBit. [bit > 0] whileTrue: [ diff >= step ifTrue: [ delta _ delta + bit. predictedDelta _ predictedDelta + step. diff _ diff - step]. step _ step bitShift: -1. bit _ bit bitShift: -1]. predictedDelta _ predictedDelta + step. "compute and clamp new prediction" sign > 0 ifTrue: [predicted _ predicted - predictedDelta] ifFalse: [predicted _ predicted + predictedDelta]. predicted > 32767 ifTrue: [predicted _ 32767] ifFalse: [predicted < -32768 ifTrue: [predicted _ -32768]]. "compute new index and step values" index _ index + (indexTable at: delta + 1). index < 0 ifTrue: [index _ 0] ifFalse: [index > 88 ifTrue: [index _ 88]]. step _ stepSizeTable at: index + 1. "output encoded, signed delta" self nextBits: bitsPerSample put: (sign bitOr: delta)]]. bitPosition > 0 ifTrue: [ "flush the last output byte, if necessary" encodedBytes at: (byteIndex _ byteIndex + 1) put: currentByte]. ! ! !ADPCMCodec methodsFor: 'as yet unclassified' stamp: 'ar 2/3/2001 15:51'! privateEncodeStereo: count "not yet implemented" self inline: false. self success: false.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ADPCMCodec class instanceVariableNames: ''! !ADPCMCodec class methodsFor: 'instance creation' stamp: 'jm 3/27/1999 11:15'! new ^ super new initializeForBitsPerSample: 4 samplesPerFrame: 0. ! ! !ADPCMCodec class methodsFor: 'primitive generation' stamp: 'ar 2/3/2001 15:50'! translatedPrimitives "Answer a string containing the translated C code for my primitives." "Note: This code currently must be hand-edited to remove several methods that are inlined (thus not needed) but not pruned out by the ST-to-C translator." ^#( (ADPCMCodec privateDecodeMono:) (ADPCMCodec privateDecodeStereo:) (ADPCMCodec privateEncodeMono:) (ADPCMCodec privateEncodeStereo:) (ADPCMCodec indexForDeltaFrom:to:) (ADPCMCodec nextBits:) (ADPCMCodec nextBits:put:)) ! ! InterpreterPlugin subclass: #ADPCMCodecPlugin instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'VMConstruction-Plugins'! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ADPCMCodecPlugin class instanceVariableNames: ''! !ADPCMCodecPlugin class methodsFor: 'translation' stamp: 'ar 2/3/2001 18:34'! translateOn: cg inlining: inlineFlag to: fullName local: localFlag "ADPCMCodecPlugin translateLocally" | code | cg addClass: InterpreterPlugin. InterpreterPlugin declareCVarsIn: cg. cg addMethodsForPrimitives: ADPCMCodec translatedPrimitives. "now remove a few which will be inlined but not pruned" cg pruneMethods: #(indexForDeltaFrom:to: nextBits: nextBits:put:). code _ cg generateCodeStringForPrimitives. self storeString: code onFileNamed: fullName.! ! MacExternalData variableWordSubclass: #AEDesc instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'VMConstruction-Applescript'! !AEDesc commentStamp: '' prior: 0! I represent an Apple Event Descriptor. I am a low-level representation of Apple Event (and hence Applescript) information. For further Information, see Apple's Inside Macintosh: Interapplication Communications, at http://developer.apple.com/techpubs/mac/IAC/IAC-2.html. Essentially, I represent a record comprising a one-word "string" (treating the word as fourbyte characters) representing a data type, followed by a pointer to a pointer (a handle) to the data I represent. Care must be taken to assure that the Handle data is disposed after use, or memory leaks result. At this time, I make no effort to do this automatically through finalization.! ]style[(218 54 384)f1,f1Rhttp://developer.apple.com/techpubs/mac/IAC/IAC-2.html;,f1! !AEDesc methodsFor: 'accessing' stamp: 'acg 9/12/1999 21:33'! dataSize ^self handleSizeAt: 2! ! !AEDesc methodsFor: 'accessing' stamp: 'acg 9/20/1999 14:22'! dispose (0 = (self at: 2)) ifTrue: [self error: 'cannot dispose of unallocated space']. self primAEDisposeDesc isZero ifFalse: [self error: 'dispose operation failed']. self at: 1 put: 0. self at: 2 put: 0. ^nil! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/24/1999 00:35'! asCompiledApplescript | theSize | ((self at: 1) ~= 16r73637074) ifTrue: [^self error: 'AEDesc is not of type ''scpt''']. (theSize _ self dataSize) < 0 ifTrue: [^self error: 'Invalid size for data']. ^self primAEDescToString: (CompiledApplescript new: theSize). ! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/24/1999 00:31'! asCompiledApplescriptThenDispose | CAD | CAD _ self asCompiledApplescript. self dispose. ^CAD! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/26/1999 18:39'! asOSAIDThenDisposeAEDescWith: aComponent ^aComponent loadAndDisposeAEDesc: self mode: 0! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/23/1999 23:46'! asShort ^(self primAEDescToString: (ByteArray new: 2)) shortAt: 1 bigEndian: true! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/23/1999 23:47'! asShortThenDispose | short | short _ self asShort. self dispose. ^short! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/20/1999 14:19'! asString | theSize | ((self at: 1) ~= 16r54455854) ifTrue: [^self error: 'AEDesc is not of type ''TEXT''']. (theSize _ self dataSize) < 0 ifTrue: [^self error: 'Invalid size for data']. ^self primAEDescToString: (String new: theSize). ! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/21/1999 00:13'! asStringThenDispose | string | string _ self asString. self dispose. ^string! ! !AEDesc methodsFor: 'converting' stamp: 'acg 9/26/1999 01:15'! to: aString | newAEDesc result | newAEDesc _ AEDesc new. result _ self primAECoerceDesc: (DescType of: aString) to: newAEDesc. result isZero ifFalse: [^result]. self dispose. self at: 1 put: (newAEDesc at: 1). self at: 2 put: (newAEDesc at: 2). ^0! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/24/1999 00:38'! createFromScpt: aCompiledApplescriptData (aCompiledApplescriptData class = CompiledApplescript) ifFalse: [^self error: 'textType Data Not From CompiledApplescriptData']. (self primAECreateDesc: (DescType of: 'scpt') from: aCompiledApplescriptData) isZero ifTrue: [^self]. self error: 'failed to create aeDesc'. ^nil! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/20/1999 14:39'! createFromText: aString (aString class = String) ifFalse: [^self error: 'TextType Data Not From String']. (self primAECreateDesc: (DescType of: 'TEXT') from: aString) isZero ifTrue: [^self]. self error: 'failed to create aeDesc'. ^nil! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/25/1999 22:54'! createNull (self primAECreateDesc: (DescType of: 'null') from: '') isZero ifTrue: [^self]. self error: 'failed to create aeDesc'. ^nil! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/23/1999 22:51'! primAECoerceDesc: typeCode to: result ^TestOSAPlugin doPrimitive: 'primAECoerceDesc:to:' withArguments: {typeCode. result}! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/20/1999 13:25'! primAECreateDesc: typeCode from: aString ^TestOSAPlugin doPrimitive: 'primAECreateDesc:from:' withArguments: {typeCode. aString}! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/23/1999 21:13'! primAEDescToString: aString ^TestOSAPlugin doPrimitive: 'primAEDescToString:' withArguments: {aString}! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/20/1999 13:28'! primAEDisposeDesc ^TestOSAPlugin doPrimitive: 'primAEDisposeDesc' withArguments: {}! ! !AEDesc methodsFor: 'private' stamp: 'acg 9/23/1999 22:20'! primAEGetKeyPtr: keyDesc type: typeDesc actual: ignoreDesc to: aByteArray ^TestOSAPlugin doPrimitive: 'primAEGetKeyPtr:type:actual:to:' withArguments: {keyDesc. typeDesc. ignoreDesc. aByteArray}! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AEDesc class instanceVariableNames: ''! !AEDesc class methodsFor: 'as yet unclassified' stamp: 'acg 9/20/1999 22:17'! new ^super new: 2! ! !AEDesc class methodsFor: 'as yet unclassified' stamp: 'acg 9/25/1999 22:53'! nullType ^self new createNull! ! !AEDesc class methodsFor: 'as yet unclassified' stamp: 'acg 9/22/1999 08:05'! scptTypeOn: aCompiledApplescriptData ^(self new) createFromScpt: aCompiledApplescriptData ! ! !AEDesc class methodsFor: 'as yet unclassified' stamp: 'acg 9/20/1999 13:30'! textTypeOn: aString ^(self new) createFromText: aString ! ! !AEDesc class methodsFor: 'private' stamp: 'acg 9/12/1999 20:49'! primSizeAEDesc ^-1! ! Object subclass: #AIFFFileReader instanceVariableNames: 'in fileType channelCount frameCount bitsPerSample samplingRate channelData markers pitch gain isLooped skipDataChunk mergeIfStereo ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! !AIFFFileReader commentStamp: '' prior: 0! I am a parser for AIFF (audio interchange file format) files. I can read uncompressed 8-bit and 16-bit mono, stereo, or multichannel AIFF files. I read the marker information used by the TransferStation utility to mark the loop points in sounds extracted from commercial sampled-sound CD-ROMs. ! !AIFFFileReader methodsFor: 'reading'! readFrom: binaryStream mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag "Read the AIFF file of the given name. If mergeFlag is true and the file contains stereo data, then the left and right channels will be mixed together as the samples are read in. If skipDataFlag is true, then the data chunk to be skipped; this allows the other chunks of a file to be processed in order to extract format information quickly without reading the data." "AIFFFileReader new readFromFile: 'test.aif' mergeIfStereo: false skipDataChunk: false" mergeIfStereo _ mergeFlag. skipDataChunk _ skipDataFlag. isLooped _ false. gain _ 1.0. self readFrom: binaryStream. binaryStream close. ! ! !AIFFFileReader methodsFor: 'reading' stamp: 'jm 8/2/1998 16:27'! readFromFile: fileName "Read the AIFF file of the given name." "AIFFFileReader new readFromFile: 'test.aiff'" self readFromFile: fileName mergeIfStereo: false skipDataChunk: false. ! ! !AIFFFileReader methodsFor: 'reading'! readFromFile: fileName mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag "Read the AIFF file of the given name. If mergeFlag is true and the file contains stereo data, then the left and right channels will be mixed together as the samples are read in. If skipDataFlag is true, then the data chunk to be skipped; this allows the other chunks of a file to be processed in order to extract format information quickly without reading the data." "AIFFFileReader new readFromFile: 'test.aiff' mergeIfStereo: false skipDataChunk: true" | binaryStream | binaryStream _ (FileStream readOnlyFileNamed: fileName) binary. self readFrom: binaryStream mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 21:25'! bitsPerSample ^ bitsPerSample ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 21:24'! channelCount ^ channelCount ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 21:25'! channelData ^ channelData ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 21:24'! frameCount ^ frameCount ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 21:25'! gain ^ gain ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 7/12/1998 01:40'! isLooped ^ isLooped ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 20:02'! isStereo ^ channelData size = 2 ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 7/12/1998 18:26'! leftSamples ^ channelData at: 1 ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 7/12/1998 18:30'! loopEnd ^ markers last last ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 7/12/1998 18:30'! loopLength ^ markers last last - markers first last ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 21:25'! markers ^ markers ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 7/12/1998 01:48'! pitch ^ pitch ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 8/2/1998 19:34'! rightSamples ^ channelData at: 2 ! ! !AIFFFileReader methodsFor: 'accessing' stamp: 'jm 7/12/1998 18:25'! samplingRate ^ samplingRate ! ! !AIFFFileReader methodsFor: 'other' stamp: 'jm 8/17/1998 20:36'! edit | ed | ed _ WaveEditor new. ed data: channelData first. ed loopEnd: markers last last. ed loopLength: (markers last last - markers first last) + 1. ed openInWorld. ! ! !AIFFFileReader methodsFor: 'other' stamp: 'jm 7/12/1998 01:44'! pitchForKey: midiKey "Convert my MIDI key number to a pitch and return it." | indexInOctave octave p | indexInOctave _ (midiKey \\ 12) + 1. octave _ (midiKey // 12) + 1. "Table generator: (0 to: 11) collect: [:i | 16.3516 * (2.0 raisedTo: i asFloat / 12.0)]" p _ #(16.3516 17.32391 18.35405 19.44544 20.60173 21.82677 23.12466 24.49972 25.95655 27.50000 29.13524 30.86771) at: indexInOctave. ^ p * (#(0.5 1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0) at: octave) ! ! !AIFFFileReader methodsFor: 'other' stamp: 'jm 1/14/1999 10:11'! sound "Answer the sound represented by this AIFFFileReader. This method should be called only after readFrom: has been done." | snd rightSnd | snd _ SampledSound samples: (channelData at: 1) samplingRate: samplingRate. self isStereo ifTrue: [ rightSnd _ SampledSound samples: (channelData at: 2) samplingRate: samplingRate. snd _ MixedSound new add: snd pan: 0; add: rightSnd pan: 1.0]. ^ snd ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 6/29/1998 07:33'! readChunk: chunkType size: chunkSize "Read a AIFF chunk of the given type. Skip unrecognized chunks. Leave the input stream positioned chunkSize bytes past its position when this method is called." chunkType = 'COMM' ifTrue: [^ self readCommonChunk: chunkSize]. chunkType = 'SSND' ifTrue: [^ self readSamplesChunk: chunkSize]. chunkType = 'INST' ifTrue: [^ self readInstrumentChunk: chunkSize]. chunkType = 'MARK' ifTrue: [^ self readMarkerChunk: chunkSize]. in skip: chunkSize. "skip unknown chunks" ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 7/12/1998 18:24'! readCommonChunk: chunkSize "Read a COMM chunk. All AIFF files have exactly one chunk of this type." | compressionType | channelCount _ in nextNumber: 2. frameCount _ in nextNumber: 4. bitsPerSample _ in nextNumber: 2. samplingRate _ self readExtendedFloat. chunkSize > 18 ifTrue: [ fileType = 'AIFF' ifTrue: [self error: 'unexpectedly long COMM chunk size for AIFF file']. compressionType _ (in next: 4) asString. compressionType = 'NONE' ifFalse: [self error: 'cannot read compressed AIFF files']. in skip: (chunkSize - 22)]. "skip the reminder of AIFF-C style chunk" ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 6/29/1998 11:43'! readExtendedFloat "Read and answer an Apple extended-precision 80-bit floating point number from the input stream." "Details: I could not find the specification for this format, so constants were determined empirically based on assumption of 1-bit sign, 15-bit exponent, 64-bit mantissa. This format does not seem to have an implicit one before the mantissa as some float formats do." | signAndExp mantissa sign exp | signAndExp _ in nextNumber: 2. mantissa _ in nextNumber: 8. "scaled by (2 raisedTo: -64) below" (signAndExp bitAnd: 16r8000) = 0 ifTrue: [sign _ 1.0] ifFalse: [sign _ -1.0]. exp _ (signAndExp bitAnd: 16r7FFF) - 16r4000 + 2. "not sure why +2 is needed..." ^ (sign * mantissa asFloat * (2.0 raisedTo: exp - 64)) roundTo: 0.00000001 ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/2/1998 19:58'! readFrom: aBinaryStream "Read AIFF data from the given binary stream." "Details: An AIFF file consists of a header (FORM chunk) followed by a sequence of tagged data chunks. Each chunk starts with a header consisting of a four-byte tag (a string) and a four byte size. These eight bytes of chunk header are not included in the chunk size. For each chunk, the readChunk:size: method consumes chunkSize bytes of the input stream, parsing recognized chunks or skipping unrecognized ones. If chunkSize is odd, it will be followed by a padding byte. Chunks may occur in any order." | sz end chunkType chunkSize p | in _ aBinaryStream. "read FORM chunk" (in next: 4) asString = 'FORM' ifFalse: [^ self error: 'not an AIFF file']. sz _ in nextNumber: 4. end _ in position + sz. fileType _ (in next: 4) asString. [in atEnd not and: [in position < end]] whileTrue: [ chunkType _ (in next: 4) asString. chunkSize _ in nextNumber: 4. p _ in position. self readChunk: chunkType size: chunkSize. (in position = (p + chunkSize)) ifFalse: [self error: 'chunk size mismatch; bad AIFF file?']. chunkSize odd ifTrue: [in skip: 1]]. "skip padding byte" ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/5/1998 17:31'! readInstrumentChunk: chunkSize | midiKey detune lowNote highNote lowVelocity highVelocity sustainMode sustainStartID sustainEndID releaseMode releaseStartID releaseEndID | midiKey _ in next. detune _ in next. lowNote _ in next. highNote _ in next. lowVelocity _ in next. highVelocity _ in next. gain _ in nextNumber: 2. sustainMode _ in nextNumber: 2. sustainStartID _ in nextNumber: 2. sustainEndID _ in nextNumber: 2. releaseMode _ in nextNumber: 2. releaseStartID _ in nextNumber: 2. releaseEndID _ in nextNumber: 2. isLooped _ sustainMode = 1. (isLooped and: [markers notNil]) ifTrue: [ ((markers first last > frameCount) or: [markers last last > frameCount]) ifTrue: [ "bad loop data; some sample CD files claim to be looped but aren't" isLooped _ false]]. pitch _ self pitchForKey: midiKey. ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/2/1998 21:22'! readMarkerChunk: chunkSize | markerCount id position labelBytes label | markerCount _ in nextNumber: 2. markers _ Array new: markerCount. 1 to: markerCount do: [:i | id _ in nextNumber: 2. position _ in nextNumber: 4. labelBytes _ in next. label _ (in next: labelBytes) asString. labelBytes even ifTrue: [in skip: 1]. markers at: i put: (Array with: id with: label with: position)]. ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/2/1998 18:58'! readMergedStereoChannelDataFrom: s "Read stereophonic channel data from the given stream, mixing the two channels to create a single monophonic channel. Each frame contains two samples." | buf w1 w2 | buf _ channelData at: 1. bitsPerSample = 8 ifTrue: [ 1 to: frameCount do: [:i | w1 _ s next. w1 > 127 ifTrue: [w1 _ w1 - 256]. w2 _ s next. w2 > 127 ifTrue: [w2 _ w2 - 256]. buf at: i put: ((w1 + w2) bitShift: 7)]] ifFalse: [ 1 to: frameCount do: [:i | w1 _ (s next bitShift: 8) + s next. w1 > 32767 ifTrue: [w1 _ w1 - 65536]. w2 _ (s next bitShift: 8) + s next. w2 > 32767 ifTrue: [w2 _ w2 - 65536]. buf at: i put: ((w1 + w2) bitShift: -1)]]. ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/2/1998 18:53'! readMonoChannelDataFrom: s "Read monophonic channel data from the given stream. Each frame contains a single sample." | buf w | buf _ channelData at: 1. "the only buffer" bitsPerSample = 8 ifTrue: [ 1 to: frameCount do: [:i | w _ s next. w > 127 ifTrue: [w _ w - 256]. buf at: i put: (w bitShift: 8)]] ifFalse: [ 1 to: frameCount do: [:i | w _ (s next bitShift: 8) + s next. w > 32767 ifTrue: [w _ w - 65536]. buf at: i put: w]]. ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/2/1998 18:55'! readMultiChannelDataFrom: s "Read multi-channel data from the given stream. Each frame contains channelCount samples." | w | bitsPerSample = 8 ifTrue: [ 1 to: frameCount do: [:i | 1 to: channelCount do: [:ch | w _ s next. w > 127 ifTrue: [w _ w - 256]. (channelData at: ch) at: i put: (w bitShift: 8)]]] ifFalse: [ 1 to: frameCount do: [:i | 1 to: channelCount do: [:ch | w _ (s next bitShift: 8) + s next. w > 32767 ifTrue: [w _ w - 65536]. (channelData at: ch) at: i put: w]]]. ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/3/1998 14:55'! 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 | skipDataChunk ifTrue: [in skip: chunkSize. ^ self]. 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']. (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. ! ! !AIFFFileReader methodsFor: 'private' stamp: 'jm 8/2/1998 18:56'! readStereoChannelDataFrom: s "Read stereophonic channel data from the given stream. Each frame contains two samples." | left right w | left _ channelData at: 1. right _ channelData at: 2. bitsPerSample = 8 ifTrue: [ 1 to: frameCount do: [:i | w _ s next. w > 127 ifTrue: [w _ w - 256]. left at: i put: (w bitShift: 8). w _ s next. w > 127 ifTrue: [w _ w - 256]. right at: i put: (w bitShift: 8)]] ifFalse: [ 1 to: frameCount do: [:i | w _ (s next bitShift: 8) + s next. w > 32767 ifTrue: [w _ w - 65536]. left at: i put: w. w _ (s next bitShift: 8) + s next. w > 32767 ifTrue: [w _ w - 65536]. right at: i put: w]]. ! ! Animation subclass: #AbsoluteAnimation instanceVariableNames: 'lastStartState ' classVariableNames: '' poolDictionaries: '' category: 'Balloon3D-Wonderland Time'! !AbsoluteAnimation commentStamp: '' prior: 0! An AbsoluteAnimation is any animation where the final state of the animation is always the same. Every time this animation runs we store the initial state, so that when the animation is reversed and run we can determine what that end point should be. ! !AbsoluteAnimation methodsFor: 'management' stamp: 'jsp 2/16/1999 16:36'! prologue: currentTime "Extends the AbstractAnimation prologue by saving the start state of the animation." undoable ifTrue: [ (myWonderland getUndoStack) push: (UndoAnimation new: (self makeUndoVersion)). ]. (direction = Forward) ifTrue: [ startState _ getStartStateFunction value. lastStartState _ startState. endState _ getEndStateFunction value. ] ifFalse: [ startState _ getStartStateFunction value. endState _ lastStartState. ]. super prologue: currentTime. ! ! !AbsoluteAnimation methodsFor: 'initialization' stamp: 'jsp 3/9/1999 15:49'! object: anObject update: func getStartState: startFunc getEndState: endFunc style: styleFunc duration: time undoable: canUndo inWonderland: aWonderland "This method initializes the Animation with all the information that it needs to run." lastStartState _ startFunc value. super object: anObject update: func getStartState: startFunc getEndState: endFunc style: styleFunc duration: time undoable: canUndo inWonderland: aWonderland. ! ! !AbsoluteAnimation methodsFor: 'copying' stamp: 'jsp 3/9/1999 15:49'! copy "Creates a copy of the animation" | anim | anim _ AbsoluteAnimation new. anim object: animatedObject update: updateFunction getStartState: getStartStateFunction getEndState: getEndStateFunction style: styleFunction duration: duration undoable: undoable inWonderland: myWonderland. (direction = Forward) ifFalse: [ anim reverseDirection ]. ^ anim. ! ! !AbsoluteAnimation methodsFor: 'copying' stamp: 'jsp 3/9/1999 15:49'! makeUndoVersion "Creates the undo version of an animation" | anim | anim _ AbsoluteAnimation new. anim object: animatedObject update: updateFunction getStartState: getStartStateFunction getEndState: getEndStateFunction style: styleFunction duration: 0.5 undoable: false inWonderland: myWonderland. anim stop. (direction = Forward) ifTrue: [ anim reverseDirection ]. ^ anim. ! ! !AbsoluteAnimation methodsFor: 'copying' stamp: 'jsp 4/9/1999 14:22'! reversed "Creates a reversed version of an animation" | anim | anim _ AbsoluteAnimation new. anim object: animatedObject update: updateFunction getStartState: getStartStateFunction getEndState: getEndStateFunction style: styleFunction duration: duration undoable: true inWonderland: myWonderland. anim stop. (direction = Forward) ifTrue: [ anim reverseDirection ]. ^ anim. ! ! Object subclass: #AbstractAnimation instanceVariableNames: 'startTime endTime duration state direction loopCount undoable myScheduler myWonderland pausedInterval animatedObject ' classVariableNames: 'Finished Forward Infinity Paused Reverse Running Stopped Waiting ' poolDictionaries: '' category: 'Balloon3D-Wonderland Time'! !AbstractAnimation commentStamp: '' prior: 0! This class implements the basic functionality of Animations for Wonderlands. All animations pass through 4 specific stages: Waiting - this is the state animations are in when they are just started, before they run their prologue (perform any tasks they need to do before the animation actually starts) Running - this is the state animations are in when they are actually running Stopped - this is the state animations are in after they stop running but before they execute their prologue Finished - this is the state animations are in after they finish their epilogue (perform any tasks they need to do after the animation completes). ! !AbstractAnimation methodsFor: 'accessing' stamp: 'jsp 3/9/1999 15:45'! getAnimatedObject "Return the object that this animation affects" ^ animatedObject. ! ! !AbstractAnimation methodsFor: 'accessing' stamp: 'jsp 2/26/1999 12:41'! getLoopCount "Returns the animation's current loop count" ^ loopCount. ! ! !AbstractAnimation methodsFor: 'accessing' stamp: 'jsp 2/4/1999 10:22'! getState "Returns the current state of the animation." ^ state. ! ! !AbstractAnimation methodsFor: 'accessing' stamp: 'jsp 2/3/1999 14:23'! isDone "Returns true if the animation is running" ^ (state = Stopped). ! ! !AbstractAnimation methodsFor: 'accessing' stamp: 'jsp 2/26/1999 12:01'! isLooping "Returns true if the animation is looping" ^ ( loopCount > 1) or: [ loopCount = Infinity ]. ! ! !AbstractAnimation methodsFor: 'accessing' stamp: 'jsp 2/26/1999 12:42'! setLoopCount: count "Sets the animation's current loop count" loopCount _ count. ! ! !AbstractAnimation methodsFor: 'accessing' stamp: 'jsp 2/26/1999 12:23'! setUndoable: aBoolean "Sets the animation's undoable property" undoable _ aBoolean. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 3/3/1999 12:38'! copy self subclassResponsibility. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 3/3/1999 12:06'! epilogue: currentTime "This method does any work that needs to be done after an interation of the animation finishes." (loopCount = Infinity) ifTrue: [state _ Waiting] ifFalse: [ loopCount _ loopCount - 1. (loopCount > 0) ifTrue: [ state _ Waiting ] ifFalse: [state _ Stopped. loopCount _ 1 ]. ]. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 14:47'! getDuration "This method returns the duration of the animation." ^ duration. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 3/24/1999 15:48'! loop "This method causes an animation to loop forever." loopCount _ Infinity. (state = Stopped) ifTrue: [ state _ Waiting. myScheduler addAnimation: self. ]. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 15:10'! loop: numberOfTimes "This method causes an animation to loop for the specified number of times." loopCount _ numberOfTimes. (state = Stopped) ifTrue: [ state _ Waiting. myScheduler addAnimation: self. ]. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 3/3/1999 12:37'! looped "This method creates a copy of an animation and loops it forever." | anim | anim _ self copy. anim setLoopCount: Infinity. ^ anim. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 3/3/1999 12:36'! looped: numberOfTimes "This method creates a copy of an animation and loops it for the specified number of times." | anim | anim _ self copy. anim setLoopCount: numberOfTimes. ^ anim. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 14:43'! pause "This method pauses an active Animation." (state = Running) ifTrue: [ state _ Paused. pausedInterval _ (myScheduler getTime) - startTime.]. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 14:56'! prologue: currentTime "This method does any work that needs to be done before the animation starts, including possibly adding the current state to the undo stack." "Undo stack stuff here" undoable ifTrue: []. startTime _ currentTime. endTime _ startTime + duration. state _ Running. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/26/1999 15:21'! resume "This method resumes a paused animation" (state = Paused) ifTrue: [ state _ Running. startTime _ (myScheduler getTime) - pausedInterval. endTime _ startTime + duration. ] ifFalse: [(state = Stopped) ifTrue: [ state _ Waiting. myScheduler addAnimation: self. ]. ] ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 15:00'! start "This method starts an existing animation" state _ Waiting. loopCount _ 1. myScheduler addAnimation: self. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 14:25'! stop "This method changes the state of an animation to stopped. If it is currently active, the Scheduler will remove it from the list of active animations." state _ Stopped. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 14:50'! stopLooping "This method causes the animation to stop looping; the current interation of the animation completes before the animation stops." loopCount _ 1. ! ! !AbstractAnimation methodsFor: 'management' stamp: 'jsp 2/3/1999 14:53'! update: currentTime "Updates the animation using the current Wonderland time" (state = Waiting) ifTrue: [self prologue: currentTime]. (state = Running) ifTrue: []. (state = Finished) ifTrue: [self epilogue: currentTime]. ! ! !AbstractAnimation methodsFor: 'reversing' stamp: 'jsp 2/15/1999 10:28'! reverseDirection "Changes the direction an animation runs in (forward or in reverse)" (direction = Forward) ifTrue: [ direction _ Reverse ] ifFalse: [ direction _ Forward ]. ! ! !AbstractAnimation methodsFor: 'private' stamp: 'jsp 2/26/1999 14:21'! scaleDuration: scaleAmount "Scales the animation's duration by the specified amount" duration _ duration * scaleAmount. ! ! !AbstractAnimation methodsFor: 'private' stamp: 'jsp 2/26/1999 14:17'! setDirection: aDirection "Sets the animation's direction variable" direction _ aDirection. ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AbstractAnimation class instanceVariableNames: ''! !AbstractAnimation class methodsFor: 'class initialization' stamp: 'jsp 3/24/1999 11:01'! initialize "Initialize the class variables" Waiting _ 1. Running _ 2. Paused _ 3. Finished _ 4. Stopped _ 5. Forward _ 0. Reverse _ 1. Infinity _ -1. ! ! Object subclass: #AbstractFont instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'TextConstants ' category: 'Graphics-Text'! !AbstractFont commentStamp: '' prior: 0! AbstractFont defines the generic interface that all fonts need to implement.! !AbstractFont methodsFor: 'accessing' stamp: 'ar 5/19/2000 14:56'! characterToGlyphMap "Return the character to glyph mapping table. If the table is not provided the character scanner will query the font directly for the width of each individual character." ^nil! ! !AbstractFont methodsFor: 'accessing' stamp: 'ar 5/19/2000 14:57'! xTable "Return the xTable for the font. The xTable defines the left x-value for each individual glyph in the receiver. If such a table is not provided, the character scanner will ask the font directly for the appropriate width of each individual character." ^nil! ! !AbstractFont methodsFor: 'measuring' stamp: 'ar 5/19/2000 15:00'! composeWord: aTextLineInterval in: sourceString beginningAt: xInteger "Non-primitive composition of a word--add up widths of characters, add sum to beginning x and answer the resulting x. Similar to performance of scanning primitive, but without stop conditions." | character resultX | resultX _ xInteger. aTextLineInterval do: [:i | character _ sourceString at: i. resultX _ resultX + (self widthOf: character)]. ^resultX! ! !AbstractFont methodsFor: 'measuring' stamp: 'ar 5/19/2000 14:58'! widthOf: aCharacter "Return the width of the given character" ^self subclassResponsibility! ! !AbstractFont methodsFor: 'measuring' stamp: 'ar 5/19/2000 15:00'! widthOfString: aString ^ self composeWord: (1 to: aString size) in: aString beginningAt: 0 " TextStyle default defaultFont widthOfString: 'zort' 21 "! ! !AbstractFont methodsFor: 'displaying' stamp: 'ar 5/19/2000 14:59'! displayString: aString on: aDisplayContext from: startIndex to: stopIndex at: aPoint kern: kernDelta "Draw the given string from startIndex to stopIndex at aPoint on the (already prepared) display context." ^self subclassResponsibility! ! !AbstractFont methodsFor: 'displaying' stamp: 'ar 5/19/2000 14:59'! installOn: aDisplayContext foregroundColor: foregroundColor backgroundColor: backgroundColor "Install the receiver on the given DisplayContext (either BitBlt or Canvas) for further drawing operations." ^self subclassResponsibility! ! Model subclass: #AbstractHierarchicalList instanceVariableNames: 'currentSelection myBrowser ' classVariableNames: '' poolDictionaries: '' category: 'Tools-Explorer'! !AbstractHierarchicalList commentStamp: '' prior: 0! Contributed by Bob Arning as part of the ObjectExplorer package. ! !AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 6/21/1999 15:22'! genericMenu: aMenu aMenu add: 'no menu yet' target: self selector: #yourself. ^aMenu! ! !AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:44'! getCurrentSelection ^currentSelection! ! !AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:46'! noteNewSelection: x currentSelection _ x. self changed: #getCurrentSelection. currentSelection ifNil: [^self]. currentSelection sendSettingMessageTo: self. ! ! !AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:53'! perform: selector orSendTo: otherTarget "Selector was just chosen from a menu by a user. If can respond, then perform it on myself. If not, send it to otherTarget, presumably the editPane from which the menu was invoked." (self respondsTo: selector) ifTrue: [^ self perform: selector] ifFalse: [^ otherTarget perform: selector]! ! !AbstractHierarchicalList methodsFor: 'as yet unclassified' stamp: 'RAA 4/7/1999 16:47'! update: aSymbol aSymbol == #hierarchicalList ifTrue: [ ^self changed: #getList ]. super update: aSymbol! ! Object subclass: #AbstractInstructionPrinter instanceVariableNames: 'bingo ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Methods'! !AbstractInstructionPrinter commentStamp: '' prior: 0! My job is to make it easier to scan bytecodes for specific actions, e.g. any instance variable reference. BlockContext allInstances collect: [ :x | {x. x hasInstVarRef} ].! !AbstractInstructionPrinter methodsFor: 'initialize-release' stamp: 'RAA 1/5/2001 08:43'! interpretNextInstructionUsing: aScanner bingo _ false. aScanner interpretNextInstructionFor: self. ^bingo! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! blockReturnTop "Print the Return Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! doDup "Print the Duplicate Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! doPop "Print the Remove Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:31'! jump: offset "Print the Unconditional Jump bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:32'! jump: offset if: condition "Print the Conditional Jump bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! methodReturnConstant: value "Print the Return Constant bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! methodReturnReceiver "Print the Return Self bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! methodReturnTop "Print the Return Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! popIntoLiteralVariable: anAssociation "Print the Remove Top Of Stack And Store Into Literal Variable bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! popIntoReceiverVariable: offset "Print the Remove Top Of Stack And Store Into Instance Variable bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:33'! popIntoTemporaryVariable: offset "Print the Remove Top Of Stack And Store Into Temporary Variable bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! pushActiveContext "Print the Push Active Context On Top Of Its Own Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! pushConstant: value "Print the Push Constant, value, on Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! pushLiteralVariable: anAssociation "Print the Push Contents Of anAssociation On Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! pushReceiver "Print the Push Active Context's Receiver on Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! pushReceiverVariable: offset "Print the Push Contents Of the Receiver's Instance Variable Whose Index is the argument, offset, On Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! pushTemporaryVariable: offset "Print the Push Contents Of Temporary Variable Whose Index Is the argument, offset, On Top Of Stack bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! send: selector super: supered numArgs: numberArguments "Print the Send Message With Selector, selector, bytecode. The argument, supered, indicates whether the receiver of the message is specified with 'super' in the source method. The arguments of the message are found in the top numArguments locations on the stack and the receiver just below them." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! storeIntoLiteralVariable: anAssociation "Print the Store Top Of Stack Into Literal Variable Of Method bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! storeIntoReceiverVariable: offset "Print the Store Top Of Stack Into Instance Variable Of Method bytecode." ! ! !AbstractInstructionPrinter methodsFor: 'instruction decoding' stamp: 'RAA 1/5/2001 08:34'! storeIntoTemporaryVariable: offset "Print the Store Top Of Stack Into Temporary Variable Of Method bytecode." ! ! Object subclass: #AbstractLauncher instanceVariableNames: 'parameters ' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !AbstractLauncher commentStamp: '' prior: 0! The class AutoStart in combination with the Launcher classes provides a mechanism for starting Squeak from the command line or a web page. Parameters on the command line or in the embed tag in the web page a parsed and stored in the lauchner's parameter dictionary. Subclasses can access these parameters to determine what to do. CommandLineLauncherExample provides an example for a command line application. if you start squeak with a command line 'class Integer' it will launch a class browser on class Integer. To enable this execute CommandLineLauncherExample activate before you save the image. To disable execute CommandLineLauncherExample deactivate The PluginLauchner is an example how to use this framework to start Squeak as a browser plugin. It looks for a parameter 'src' which should point to a file containing a squeak script.! !AbstractLauncher methodsFor: 'private' stamp: 'jm 8/20/1999 15:33'! commandLine: aString "Start up this launcher from within Squeak as if it Squeak been launched the given command line." | dict tokens cmd arg | dict _ Dictionary new. tokens _ ReadStream on: (aString findTokens: ' '). [cmd _ tokens next. arg _ tokens next. ((cmd ~~ nil) and: [arg ~~ nil])] whileTrue: [dict at: cmd put: arg]. self parameters: dict. self startUp. ! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 9/23/1999 13:18'! determineParameterNameFrom: alternateParameterNames "Determine which of the given alternate parameter names is actually used." ^alternateParameterNames detect: [:each | self includesParameter: each asUppercase] ifNone: [nil] ! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 1/11/2000 16:35'! includesParameter: parName "Return if the parameter named parName exists." ^self parameters includesKey: parName asUppercase! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 9/23/1999 12:11'! numericParameterAtOneOf: alternateParameterNames ifAbsent: aBlock "Return the parameter named using one of the alternate names or an empty string" | parameterValue | parameterValue _ self parameterAtOneOf: alternateParameterNames. parameterValue isEmpty ifTrue: [^aBlock value]. ^[Number readFrom: parameterValue] ifError: [aBlock] ! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 8/4/1999 14:19'! parameterAt: parName "Return the parameter named parName or an empty string" ^self parameterAt: parName ifAbsent: ['']! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 1/11/2000 16:36'! parameterAt: parName ifAbsent: aBlock "Return the parameter named parName. Evaluate the block if parameter does not exist." ^self parameters at: parName asUppercase ifAbsent: [aBlock value]! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 9/23/1999 12:09'! parameterAtOneOf: alternateParameterNames | parameterName | "Return the parameter named using one of the alternate names or an empty string" parameterName _ self determineParameterNameFrom: alternateParameterNames. ^parameterName isNil ifTrue: [''] ifFalse: [self parameterAt: parameterName ifAbsent: ['']]! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 1/11/2000 16:53'! parameters parameters == nil ifTrue: [parameters _ self class extractParameters]. ^parameters! ! !AbstractLauncher methodsFor: 'private' stamp: 'mir 7/29/1999 10:21'! parameters: startupParameters parameters _ startupParameters! ! !AbstractLauncher methodsFor: 'running' stamp: 'mir 7/29/1999 10:22'! startUp ! ! !AbstractLauncher methodsFor: 'initialization' stamp: 'mir 8/6/1999 18:32'! initialize! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AbstractLauncher class instanceVariableNames: ''! !AbstractLauncher class methodsFor: 'private' stamp: 'mir 8/4/1999 13:57'! autoStarter ^AutoStart! ! !AbstractLauncher class methodsFor: 'private' stamp: 'mir 1/11/2000 16:54'! extractParameters | pName value index globals | globals := Dictionary new. index := 3. "Muss bei 3 starten, da 2 documentName ist" [pName := Smalltalk getSystemAttribute: index. pName isEmptyOrNil] whileFalse:[ index := index + 1. value := Smalltalk getSystemAttribute: index. value ifNil: [value _ '']. globals at: pName asUppercase put: value. index := index + 1]. ^globals! ! !AbstractLauncher class methodsFor: 'activation' stamp: 'mir 8/6/1999 18:14'! activate "Register this launcher with the auto start class" self autoStarter addLauncher: self! ! !AbstractLauncher class methodsFor: 'activation' stamp: 'mir 8/4/1999 13:57'! deactivate "Unregister this launcher with the auto start class" self autoStarter removeLauncherClass: self! ! !AbstractLauncher class methodsFor: 'instance creation' stamp: 'mir 8/6/1999 18:33'! new ^super new initialize! ! RectangleMorph subclass: #AbstractMediaEventMorph instanceVariableNames: 'startTimeInScore endTimeInScore ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Demo'! !AbstractMediaEventMorph commentStamp: '' prior: 0! An abstract representation of media events to be placed in a PianoRollScoreMorph (or others as they are developed)! !AbstractMediaEventMorph methodsFor: 'as yet unclassified' stamp: 'RAA 12/7/2000 12:58'! endTime ^endTimeInScore ifNil: [startTimeInScore + 100]! ! !AbstractMediaEventMorph methodsFor: 'as yet unclassified' stamp: 'RAA 12/7/2000 11:37'! initialize super initialize. color _ Color paleYellow. self borderColor: Color black. self borderWidth: 1. self layoutPolicy: TableLayout new. self listDirection: #leftToRight. self wrapCentering: #topLeft. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. self layoutInset: 2. self rubberBandCells: true. "default"! ! !AbstractMediaEventMorph methodsFor: 'as yet unclassified' stamp: 'RAA 12/9/2000 18:45'! justDroppedIntoPianoRoll: pianoRoll event: evt | ambientEvent | startTimeInScore _ pianoRoll timeForX: self left. ambientEvent _ AmbientEvent new morph: self; time: startTimeInScore. pianoRoll score addAmbientEvent: ambientEvent. "self endTime > pianoRoll scorePlayer durationInTicks ifTrue: [pianoRoll scorePlayer updateDuration]" ! ! Object subclass: #AbstractScoreEvent instanceVariableNames: 'time ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Scores'! !AbstractScoreEvent commentStamp: '' prior: 0! Abstract class for timed events in a MIDI score. ! !AbstractScoreEvent methodsFor: 'accessing' stamp: 'di 6/17/1999 14:28'! adjustTimeBy: delta time _ time + delta ! ! !AbstractScoreEvent methodsFor: 'accessing' stamp: 'jm 8/27/1998 16:38'! endTime "Subclasses should override to return the ending time if the event has some duration." ^ time ! ! !AbstractScoreEvent methodsFor: 'accessing' stamp: 'jm 12/31/97 11:43'! time ^ time ! ! !AbstractScoreEvent methodsFor: 'accessing' stamp: 'jm 12/31/97 11:43'! time: aNumber time _ aNumber. ! ! !AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 9/10/1998 09:43'! isControlChange ^ false ! ! !AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 12/31/97 11:46'! isNoteEvent ^ false ! ! !AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 9/10/1998 09:43'! isPitchBend ^ false ! ! !AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 9/10/1998 09:43'! isProgramChange ^ false ! ! !AbstractScoreEvent methodsFor: 'classification' stamp: 'jm 12/31/97 11:46'! isTempoEvent ^ false ! ! !AbstractScoreEvent methodsFor: 'midi' stamp: 'jm 9/10/1998 18:31'! outputOnMidiPort: aMidiPort "Output this event to the given MIDI port. This default implementation does nothing." ! ! Object subclass: #AbstractSound instanceVariableNames: 'envelopes mSecsSinceStart samplesUntilNextControl scaledVol scaledVolIncr scaledVolLimit ' classVariableNames: 'FloatScaleFactor MaxScaledValue PitchesForBottomOctave ScaleFactor Sounds TopOfBottomOctave UnloadedSnd ' poolDictionaries: '' category: 'Sound-Synthesis'! !AbstractSound methodsFor: 'initialization' stamp: 'jm 12/9/97 11:31'! duration: seconds "Scale my envelopes to the given duration. Subclasses overriding this method should include a resend to super." envelopes do: [:e | e duration: seconds]. ! ! !AbstractSound methodsFor: 'initialization' stamp: 'jm 2/4/98 09:54'! initialize envelopes _ #(). mSecsSinceStart _ 0. samplesUntilNextControl _ 0. scaledVol _ (1.0 * ScaleFactor) rounded. scaledVolIncr _ 0. scaledVolLimit _ scaledVol. ! ! !AbstractSound methodsFor: 'initialization' stamp: 'jm 3/24/1999 12:03'! loudness: aNumber "Initialize my volume envelopes and initial volume. Subclasses overriding this method should include a resend to super." | vol | vol _ (aNumber asFloat max: 0.0) min: 1.0. envelopes do: [:e | (e isKindOf: VolumeEnvelope) ifTrue: [e scale: vol]]. self initialVolume: vol. ! ! !AbstractSound methodsFor: 'initialization' stamp: 'jm 7/6/1998 17:04'! nameOrNumberToPitch: aStringOrNumber "Answer the pitch in cycles/second for the given pitch specification. The specification can be either a numeric pitch or pitch name such as 'c4'." aStringOrNumber isNumber ifTrue: [^ aStringOrNumber asFloat] ifFalse: [^ AbstractSound pitchForName: aStringOrNumber] ! ! !AbstractSound methodsFor: 'initialization' stamp: 'jm 8/19/1998 08:45'! setPitch: pitchNameOrNumber dur: d loudness: l "Initialize my envelopes for the given parameters. Subclasses overriding this method should include a resend to super." | p | p _ self nameOrNumberToPitch: pitchNameOrNumber. envelopes do: [:e | e volume: l. e centerPitch: p]. self initialVolume: l. self duration: d. ! ! !AbstractSound methodsFor: 'initialization' stamp: 'jm 8/3/1998 17:11'! soundForMidiKey: midiKey dur: d loudness: l "Answer an initialized sound object (a copy of the receiver) that generates a note for the given MIDI key (in the range 0..127), duration (in seconds), and loudness (in the range 0.0 to 1.0)." ^ self copy setPitch: (AbstractSound pitchForMIDIKey: midiKey) dur: d loudness: l ! ! !AbstractSound methodsFor: 'initialization' stamp: 'jm 8/3/1998 16:58'! soundForPitch: pitchNameOrNumber dur: d loudness: l "Answer an initialized sound object (a copy of the receiver) that generates a note of the given pitch, duration, and loudness. Pitch may be a numeric pitch or a string pitch name such as 'c4'. Duration is in seconds and loudness is in the range 0.0 to 1.0." ^ self copy setPitch: pitchNameOrNumber dur: d loudness: l ! ! !AbstractSound methodsFor: 'envelopes' stamp: 'jm 12/17/97 22:23'! addEnvelope: anEnvelope "Add the given envelope to my envelopes list." anEnvelope target: self. envelopes _ envelopes copyWith: anEnvelope. ! ! !AbstractSound methodsFor: 'envelopes' stamp: 'jm 12/15/97 17:02'! envelopes "Return my collection of envelopes." ^ envelopes ! ! !AbstractSound methodsFor: 'envelopes' stamp: 'jm 8/18/1998 09:57'! removeAllEnvelopes "Remove all envelopes from my envelopes list." envelopes _ #(). ! ! !AbstractSound methodsFor: 'envelopes' stamp: 'jm 12/15/97 17:02'! removeEnvelope: anEnvelope "Remove the given envelope from my envelopes list." envelopes _ envelopes copyWithout: anEnvelope. ! ! !AbstractSound methodsFor: 'volume' stamp: 'RAA 8/11/2000 11:51'! adjustVolumeTo: vol overMSecs: mSecs "Adjust the volume of this sound to the given volume, a number in the range [0.0..1.0], over the given number of milliseconds. The volume will be changed a little bit on each sample until the desired volume is reached." | newScaledVol | self flag: #bob. "I removed the upper limit to allow making sounds louder. hmm..." newScaledVol _ (32768.0 * vol) truncated. newScaledVol = scaledVol ifTrue: [^ self]. scaledVolLimit _ newScaledVol. "scaledVolLimit > ScaleFactor ifTrue: [scaledVolLimit _ ScaleFactor]." scaledVolLimit < 0 ifTrue: [scaledVolLimit _ 0]. mSecs = 0 ifTrue: [ "change immediately" scaledVol _ scaledVolLimit. scaledVolIncr _ 0] ifFalse: [ scaledVolIncr _ ((scaledVolLimit - scaledVol) * 1000) // (self samplingRate * mSecs)]. ! ! !AbstractSound methodsFor: 'volume' stamp: 'jm 12/17/97 17:39'! initialVolume: vol "Set the initial volume of this sound to the given volume, a number in the range [0.0..1.0]." scaledVol _ (((vol asFloat min: 1.0) max: 0.0) * ScaleFactor) rounded. scaledVolLimit _ scaledVol. scaledVolIncr _ 0. ! ! !AbstractSound methodsFor: 'volume' stamp: 'jm 8/13/1998 16:37'! loudness "Answer the current volume setting for this sound." ^ scaledVol asFloat / ScaleFactor asFloat! ! !AbstractSound methodsFor: 'volume' stamp: 'jm 8/13/1998 16:28'! volumeEnvelopeScaledTo: scalePoint "Return a collection of values representing my volume envelope scaled by the given point. The scale point's x component is pixels/second and its y component is the number of pixels for full volume." self error: 'not yet implemented'. ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 1/26/98 22:05'! computeSamplesForSeconds: seconds "Compute the samples of this sound without outputting them, and return the resulting buffer of samples." | buf | self reset. buf _ SoundBuffer newStereoSampleCount: (self samplingRate * seconds) asInteger. self playSampleCount: buf stereoSampleCount into: buf startingAt: 1. ^ buf ! ! !AbstractSound methodsFor: 'playing' stamp: 'ar 12/5/1998 22:20'! isPlaying "Return true if the receiver is currently playing" ^ SoundPlayer isPlaying: self! ! !AbstractSound methodsFor: 'playing' stamp: 'di 5/30/1999 12:46'! millisecondsSinceStart ^ mSecsSinceStart! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 8/24/97 20:48'! pause "Pause this sound. It can be resumed from this point, or reset and resumed to start from the beginning." SoundPlayer pauseSound: self.! ! !AbstractSound methodsFor: 'playing'! play "Play this sound to the sound ouput port in real time." SoundPlayer playSound: self.! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 8/13/1998 15:09'! playAndWaitUntilDone "Play this sound to the sound ouput port and wait until it has finished playing before returning." SoundPlayer playSound: self. [self samplesRemaining > 0] whileTrue. (Delay forMilliseconds: 2 * SoundPlayer bufferMSecs) wait. "ensure last buffer has been output" ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 8/18/1998 10:52'! playChromaticRunFrom: startPitch to: endPitch "Play a fast chromatic run between the given pitches. Useful for auditioning a sound." (AbstractSound chromaticRunFrom: startPitch to: endPitch on: self) play. ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 8/13/1998 16:17'! playSampleCount: n into: aSoundBuffer startingAt: startIndex "Mix the next n samples of this sound into the given buffer starting at the given index. Update the receiver's control parameters periodically." | fullVol samplesBetweenControlUpdates pastEnd i remainingSamples count | fullVol _ AbstractSound scaleFactor. samplesBetweenControlUpdates _ self samplingRate // self controlRate. pastEnd _ startIndex + n. "index just after the last sample" i _ startIndex. [i < pastEnd] whileTrue: [ remainingSamples _ self samplesRemaining. remainingSamples <= 0 ifTrue: [^ self]. count _ pastEnd - i. samplesUntilNextControl < count ifTrue: [count _ samplesUntilNextControl]. remainingSamples < count ifTrue: [count _ remainingSamples]. self mixSampleCount: count into: aSoundBuffer startingAt: i leftVol: fullVol rightVol: fullVol. samplesUntilNextControl _ samplesUntilNextControl - count. samplesUntilNextControl <= 0 ifTrue: [ self doControl. samplesUntilNextControl _ samplesBetweenControlUpdates]. i _ i + count]. ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 7/5/1998 17:53'! playSilently "Compute the samples of this sound without outputting them. Used for performance analysis." | bufSize buf | self reset. bufSize _ self samplingRate // 10. buf _ SoundBuffer newStereoSampleCount: bufSize. [self samplesRemaining > 0] whileTrue: [ buf primFill: 0. self playSampleCount: bufSize into: buf startingAt: 1]. ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 1/26/98 22:06'! playSilentlyUntil: startTime "Compute the samples of this sound without outputting them. Used to fast foward to a particular starting time. The start time is given in seconds." | buf startSample nextSample samplesRemaining n | self reset. buf _ SoundBuffer newStereoSampleCount: (self samplingRate // 10). startSample _ (startTime * self samplingRate) asInteger. nextSample _ 1. [self samplesRemaining > 0] whileTrue: [ nextSample >= startSample ifTrue: [^ self]. samplesRemaining _ startSample - nextSample. samplesRemaining > buf stereoSampleCount ifTrue: [n _ buf stereoSampleCount] ifFalse: [n _ samplesRemaining]. self playSampleCount: n into: buf startingAt: 1. nextSample _ nextSample + n]. ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 3/4/98 13:16'! resumePlaying "Resume playing this sound from where it last stopped." SoundPlayer resumePlaying: self. ! ! !AbstractSound methodsFor: 'playing' stamp: 'jm 8/19/1998 08:30'! viewSamples | stereoBuf | stereoBuf _ self computeSamplesForSeconds: self duration. WaveEditor openOn: stereoBuf extractLeftChannel. ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 8/17/1998 13:34'! doControl "Update the control parameters of this sound using its envelopes, if any." "Note: This is only called at a small fraction of the sampling rate." | pitchModOrRatioChange | envelopes size > 0 ifTrue: [ pitchModOrRatioChange _ false. 1 to: envelopes size do: [:i | ((envelopes at: i) updateTargetAt: mSecsSinceStart) ifTrue: [pitchModOrRatioChange _ true]]. pitchModOrRatioChange ifTrue: [self internalizeModulationAndRatio]]. mSecsSinceStart _ mSecsSinceStart + (1000 // self controlRate). ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 2/4/98 08:56'! internalizeModulationAndRatio "Overridden by FMSound. This default implementation does nothing." ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 7/6/1998 06:40'! mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol "Mix the given number of samples with the samples already in the given buffer starting at the given index. Assume that the buffer size is at least (index + count) - 1. The leftVol and rightVol parameters determine the volume of the sound in each channel, where 0 is silence and ScaleFactor is full volume." self subclassResponsibility. ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 8/17/1998 13:45'! reset "Reset my internal state for a replay. Methods that override this method should do super reset." mSecsSinceStart _ 0. samplesUntilNextControl _ 0. envelopes size > 0 ifTrue: [ 1 to: envelopes size do: [:i | (envelopes at: i) reset]]. ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 12/17/97 17:57'! samplesRemaining "Answer the number of samples remaining until the end of this sound. A sound with an indefinite ending time should answer some large integer such as 1000000." ^ 1000000 ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 9/9/1998 21:56'! stopAfterMSecs: mSecs "Terminate this sound this note after the given number of milliseconds. This default implementation does nothing." ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 9/9/1998 21:54'! stopGracefully "End this note with a graceful decay. If the note has envelopes, determine the decay time from its envelopes." | decayInMs env | envelopes isEmpty ifTrue: [ self adjustVolumeTo: 0 overMSecs: 10. decayInMs _ 10] ifFalse: [ env _ envelopes first. decayInMs _ env attackTime + env decayTime]. self duration: (mSecsSinceStart + decayInMs) / 1000.0. self stopAfterMSecs: decayInMs. ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 1/5/98 14:21'! storeSample: sample in: aSoundBuffer at: sliceIndex leftVol: leftVol rightVol: rightVol "This method is provided for documentation. To gain 10% more speed when running sound generation in Smalltalk, this method is hand-inlined into all sound generation methods that use it." | i s | leftVol > 0 ifTrue: [ i _ (2 * sliceIndex) - 1. s _ (aSoundBuffer at: i) + ((sample * leftVol) // ScaleFactor). s > 32767 ifTrue: [s _ 32767]. "clipping!!" s < -32767 ifTrue: [s _ -32767]. "clipping!!" aSoundBuffer at: i put: s]. rightVol > 0 ifTrue: [ i _ 2 * sliceIndex. s _ (aSoundBuffer at: i) + ((sample * rightVol) // ScaleFactor). s > 32767 ifTrue: [s _ 32767]. "clipping!!" s < -32767 ifTrue: [s _ -32767]. "clipping!!" aSoundBuffer at: i put: s]. ! ! !AbstractSound methodsFor: 'sound generation' stamp: 'jm 12/17/97 17:57'! updateVolume "Increment the volume envelope of this sound. To avoid clicks, the volume envelope must be interpolated at the sampling rate, rather than just at the control rate like other envelopes. At the control rate, the volume envelope computes the slope and next target volume volume for the current segment of the envelope (i.e., it sets the rate of change for the volume parameter). When that target volume is reached, incrementing is stopped until a new increment is set." "This method is provided for documentation. To gain 10% more speed when running sound generation in Smalltalk, it is hand-inlined into all sound generation methods that use it." scaledVolIncr ~= 0 ifTrue: [ scaledVol _ scaledVol + scaledVolIncr. ((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or: [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]]) ifTrue: [ "reached the limit; stop incrementing" scaledVol _ scaledVolLimit. scaledVolIncr _ 0]]. ! ! !AbstractSound methodsFor: 'composition'! + aSound "Return the mix of the receiver and the argument sound." ^ MixedSound new add: self; add: aSound ! ! !AbstractSound methodsFor: 'composition'! , aSound "Return the concatenation of the receiver and the argument sound." ^ SequentialSound new add: self; add: aSound ! ! !AbstractSound methodsFor: 'composition' stamp: 'jm 2/2/1999 15:53'! asSound ^ self ! ! !AbstractSound methodsFor: 'composition' stamp: 'jm 12/17/97 18:00'! delayedBy: seconds "Return a composite sound consisting of a rest for the given amount of time followed by the receiver." ^ (RestSound dur: seconds), self ! ! !AbstractSound methodsFor: 'sampling rates' stamp: 'jm 12/15/97 14:15'! controlRate "Answer the number of control changes per second." ^ 100 ! ! !AbstractSound methodsFor: 'sampling rates' stamp: 'jm 12/17/97 18:00'! samplingRate "Answer the sampling rate in samples per second." ^ SoundPlayer samplingRate ! ! !AbstractSound methodsFor: 'copying' stamp: 'jm 12/15/97 19:15'! copy "A sound should copy all of the state needed to play itself, allowing two copies of a sound to play at the same time. These semantics require a recursive copy but only down to the level of immutable data. For example, a SampledSound need not copy its sample buffer. Subclasses overriding this method should include a resend to super." ^ self clone copyEnvelopes ! ! !AbstractSound methodsFor: 'copying' stamp: 'jm 12/17/97 22:22'! copyEnvelopes "Private!! Support for copying. Copy my envelopes." envelopes _ envelopes collect: [:e | e copy target: self]. ! ! !AbstractSound methodsFor: 'copying' stamp: 'di 3/4/1999 21:29'! sounds "Allows simple sounds to behave as, eg, sequential sounds" ^ Array with: self! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 3/13/1999 11:47'! storeAIFFOnFileNamed: fileName | f | f _ (FileStream fileNamed: fileName) binary. self storeAIFFSamples: self samples samplingRate: self originalSamplingRate on: f. f close. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 3/13/1999 11:48'! storeAIFFSamples: aSoundBuffer samplingRate: rate on: aBinaryStream | sampleCount s | sampleCount _ aSoundBuffer 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. 1 to: sampleCount do: [:i | s _ aSoundBuffer at: i. aBinaryStream nextPut: ((s bitShift: -8) bitAnd: 16rFF). aBinaryStream nextPut: (s bitAnd: 16rFF)]. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'jm 3/13/1999 11:34'! storeExtendedFloat: aNumber on: aBinaryStream "Store an Apple extended-precision 80-bit floating point number on the given stream." "Details: I could not find the specification for this format, so constants were determined empirically based on assumption of 1-bit sign, 15-bit exponent, 64-bit mantissa. This format does not seem to have an implicit one before the mantissa as some float formats do." | n isNeg exp mantissa | n _ aNumber asFloat. isNeg _ false. n < 0.0 ifTrue: [ n _ 0.0 - n. isNeg _ true]. exp _ (n log: 2.0) ceiling. mantissa _ (n * (2 raisedTo: 64 - exp)) truncated. exp _ exp + 16r4000 - 2. "not sure why the -2 is needed..." isNeg ifTrue: [exp _ exp bitOr: 16r8000]. "set sign bit" aBinaryStream nextPut: ((exp bitShift: -8) bitAnd: 16rFF). aBinaryStream nextPut: (exp bitAnd: 16rFF). 8 to: 1 by: -1 do: [:i | aBinaryStream nextPut: (mantissa digitAt: i)]. ! ! !AbstractSound methodsFor: 'file i/o' stamp: 'JMV 1/19/2001 12:08'! storeWAVOnFileNamed: fileName | f | f _ (FileStream fileNamed: fileName) binary. self storeWAVSamplesSamplingRate: self samplingRate on: f. f close.! ! !AbstractSound methodsFor: 'file i/o' stamp: 'JMV 1/26/2001 11:36'! storeWAVSamplesSamplingRate: rate on: aBinaryStream "Write WAV sound file. Stereo, 16 bit. At the appropiate sampling rate." | bufferSize buffer fullBufferCount lastBufferSize finalSampleCount | self reset. finalSampleCount _ (self duration * self samplingRate) ceiling. bufferSize _ self samplingRate rounded min: finalSampleCount. "One second. Could be any size." fullBufferCount _ finalSampleCount // bufferSize. lastBufferSize _ finalSampleCount \\ bufferSize. "File header" aBinaryStream nextPutAll: 'RIFF' asByteArray; nextLittleEndianNumber: 4 put: finalSampleCount * 4 + 36; "Lenght of all chunks" nextPutAll: 'WAVE' asByteArray. "Format Chunk" aBinaryStream nextPutAll: 'fmt ' asByteArray; nextLittleEndianNumber: 4 put: 16; "Lenght of this chunk" nextLittleEndianNumber: 2 put: 1; "Format tag" nextLittleEndianNumber: 2 put: 2; "Channel count" nextLittleEndianNumber: 4 put: self samplingRate rounded; "Samples per sec" nextLittleEndianNumber: 4 put: self samplingRate rounded * 4; "Bytes per sec" nextLittleEndianNumber: 2 put: 4; "Alignment" nextLittleEndianNumber: 2 put: 16. "Bits per sample" "Data chunk" aBinaryStream nextPutAll: 'data' asByteArray; nextLittleEndianNumber: 4 put: finalSampleCount * 4. "Lenght of this chunk" fullBufferCount timesRepeat: [ buffer _ SoundBuffer newStereoSampleCount: bufferSize. self playSampleCount: bufferSize into: buffer startingAt: 1. buffer do: [ :sample | aBinaryStream nextLittleEndianNumber: 2 put: sample \\ 65536 ]. ]. buffer _ SoundBuffer newStereoSampleCount: lastBufferSize. self playSampleCount: lastBufferSize into: buffer startingAt: 1. buffer do: [ :sample | aBinaryStream nextLittleEndianNumber: 2 put: sample \\ 65536].! ! !AbstractSound methodsFor: 'conversion' stamp: 'mjg 12/3/1999 12:58'! asSampledSound ^SampledSound samples: (self computeSamplesForSeconds: self duration) samplingRate: (self samplingRate)*2. ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AbstractSound class instanceVariableNames: ''! !AbstractSound class methodsFor: 'class initialization' stamp: 'jm 8/3/1998 16:13'! initialize "AbstractSound initialize" | bottomC | ScaleFactor _ 2 raisedTo: 15. FloatScaleFactor _ ScaleFactor asFloat. MaxScaledValue _ ((2 raisedTo: 31) // ScaleFactor) - 1. "magnitude of largest scaled value in 32-bits" "generate pitches for c-1 through c0" bottomC _ (440.0 / 32) * (2.0 raisedTo: -9.0 / 12.0). PitchesForBottomOctave _ (0 to: 12) collect: [:i | bottomC * (2.0 raisedTo: i asFloat / 12.0)]. TopOfBottomOctave _ PitchesForBottomOctave last. ! ! !AbstractSound class methodsFor: 'class initialization' stamp: 'jm 1/5/98 13:51'! scaleFactor ^ ScaleFactor ! ! !AbstractSound class methodsFor: 'instance creation' stamp: 'jm 1/5/98 17:40'! default "Return a default sound prototype for this class, with envelopes if appropriate. (This is in contrast to new, which returns a raw instance without envelopes.)" ^ self new ! ! !AbstractSound class methodsFor: 'instance creation' stamp: 'jm 12/17/97 17:26'! dur: d "Return a rest of the given duration." ^ self basicNew setDur: d ! ! !AbstractSound class methodsFor: 'instance creation' stamp: 'jm 12/17/97 17:26'! new ^ self basicNew initialize ! ! !AbstractSound class methodsFor: 'instance creation' stamp: 'jm 8/3/1998 17:00'! noteSequenceOn: aSound from: anArray "Build a note sequence (i.e., a SequentialSound) from the given array using the given sound as the instrument. Elements are either (pitch, duration, loudness) triples or (#rest duration) pairs. Pitches can be given as names or as numbers." | score pitch | score _ SequentialSound new. anArray do: [:el | el size = 3 ifTrue: [ pitch _ el at: 1. pitch isNumber ifFalse: [pitch _ self pitchForName: pitch]. score add: ( aSound soundForPitch: pitch dur: (el at: 2) loudness: (el at: 3) / 1000.0)] ifFalse: [ score add: (RestSound dur: (el at: 2))]]. ^ score ! ! !AbstractSound class methodsFor: 'instance creation' stamp: 'jm 12/17/97 17:27'! pitch: p dur: d loudness: l "Return a new sound object for a note with the given parameters." ^ self new setPitch: p dur: d loudness: l ! ! !AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:50'! busySignal: count "AbstractSound busySignal: 3" | m s | s _ SequentialSound new. m _ MixedSound new. m add: (FMSound new setPitch: 480 dur: 0.5 loudness: 0.5); add: (FMSound new setPitch: 620 dur: 0.5 loudness: 0.5). s add: m. s add: (FMSound new setPitch: 1 dur: 0.5 loudness: 0). ^ (RepeatingSound repeat: s count: count) play. ! ! !AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:56'! dial: aString | index lo hi m s | "AbstractSound dial: '867-5309'" "ask for Jenny" s _ SequentialSound new. aString do: [ :c | c = $, ifTrue: [ s add: (FMSound new setPitch: 1 dur: 1 loudness: 0) ] ifFalse: [ (index _ ('123A456B789C*0#D' indexOf: c)) > 0 ifTrue: [ lo _ #(697 770 852 941) at: (index - 1 // 4 + 1). hi _ #(1209 1336 1477 1633) at: (index - 1 \\ 4 + 1). m _ MixedSound new. m add: (FMSound new setPitch: lo dur: 0.15 loudness: 0.5). m add: (FMSound new setPitch: hi dur: 0.15 loudness: 0.5). s add: m. s add: (FMSound new setPitch: 1 dur: 0.05 loudness: 0)]]]. ^ s play. ! ! !AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:49'! dialTone: duration "AbstractSound dialTone: 2" | m | m _ MixedSound new. m add: (FMSound new setPitch: 350 dur: duration loudness: 0.5). m add: (FMSound new setPitch: 440 dur: duration loudness: 0.5). m play. ^ m! ! !AbstractSound class methodsFor: 'utilities' stamp: 'DSM 9/5/2000 13:50'! hangUpWarning: count "AbstractSound hangUpWarning: 20" | m s | s _ SequentialSound new. m _ MixedSound new. m add: (FMSound new setPitch: 1400 dur: 0.1 loudness: 0.5); add: (FMSound new setPitch: 2060 dur: 0.1 loudness: 0.5). s add: m; add: (FMSound new setPitch: 1 dur: 0.1 loudness: 0). ^ (RepeatingSound repeat: s count: count) play ! ! !AbstractSound class methodsFor: 'utilities' stamp: 'jm 8/3/1998 16:16'! indexOfBottomOctavePitch: p "Answer the index of the first pitch in the bottom octave equal to or higher than the given pitch. Assume that the given pitch is below the top pitch of the bottom octave." 1 to: PitchesForBottomOctave size do: [:i | (PitchesForBottomOctave at: i) >= p ifTrue: [^ i]]. self error: 'implementation error: argument pitch should be below or within the bottom octave'. ! ! !AbstractSound class methodsFor: 'utilities' stamp: 'jm 8/3/1998 16:16'! midiKeyForPitch: pitchNameOrNumber "Answer the midiKey closest to the given pitch. Pitch may be a numeric pitch or a pitch name string such as 'c4'." "AbstractSound midiKeyForPitch: 440.0" | p octave i midiKey | pitchNameOrNumber isNumber ifTrue: [p _ pitchNameOrNumber asFloat] ifFalse: [p _ AbstractSound pitchForName: pitchNameOrNumber]. octave _ -1. [p >= TopOfBottomOctave] whileTrue: [ octave _ octave + 1. p _ p / 2.0]. i _ self indexOfBottomOctavePitch: p. (i > 1) ifTrue: [ (p - (PitchesForBottomOctave at: i - 1)) < ((PitchesForBottomOctave at: i) - p) ifTrue: [i _ i - 1]]. midiKey _ ((octave * 12) + 11 + i). midiKey > 127 ifTrue: [midiKey _ 127]. ^ midiKey ! ! !AbstractSound class methodsFor: 'utilities' stamp: 'jm 8/3/1998 16:43'! pitchForMIDIKey: midiKey "Answer the pitch for the given MIDI key." "(1 to: 127) collect: [:i | AbstractSound pitchForMIDIKey: i]" | indexInOctave octave | indexInOctave _ (midiKey \\ 12) + 1. octave _ (midiKey // 12) + 1. ^ (PitchesForBottomOctave at: indexInOctave) * (#(1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0 1024.0) at: octave) ! ! !AbstractSound class methodsFor: 'utilities'! pitchForName: aString "AbstractSound pitchForName: 'c2'" "#(c 'c#' d eb e f fs g 'g#' a bf b) collect: [ :s | AbstractSound pitchForName: s, '4']" | s modifier octave i j noteName p | s _ ReadStream on: aString. modifier _ $n. noteName _ s next. (s atEnd not and: [s peek isDigit]) ifFalse: [ modifier _ s next ]. s atEnd ifTrue: [ octave _ 4 ] ifFalse: [ octave _ Integer readFrom: s ]. octave < 0 ifTrue: [ self error: 'cannot use negative octave number' ]. i _ 'cdefgab' indexOf: noteName. i = 0 ifTrue: [ self error: 'bad note name: ', noteName asString ]. i _ #(2 4 6 7 9 11 13) at: i. j _ 's#fb' indexOf: modifier. j = 0 ifFalse: [ i _ i + (#(1 1 -1 -1) at: j) ]. "i is now in range: [1..14]" "Table generator: (1 to: 14) collect: [ :i | 16.3516 * (2.0 raisedTo: (i - 2) asFloat / 12.0)]" p _ #(15.4339 16.3516 17.3239 18.354 19.4454 20.6017 21.8268 23.1247 24.4997 25.9565 27.5 29.1352 30.8677 32.7032) at: i. octave timesRepeat: [ p _ 2.0 * p ]. ^ p ! ! !AbstractSound class methodsFor: 'utilities' stamp: 'jm 7/6/1998 15:47'! pitchTable "AbstractSound pitchTable" | out note i | out _ WriteStream on: (String new: 1000). i _ 12. 0 to: 8 do: [:octave | #(c 'c#' d eb e f fs g 'g#' a bf b) do: [:noteName | note _ noteName, octave printString. out nextPutAll: note; tab. out nextPutAll: i printString; tab. out nextPutAll: (AbstractSound pitchForName: note) printString; cr. i _ i + 1]]. ^ out contents ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 6/30/1998 18:40'! chromaticPitchesFrom: aPitch | halfStep pitch | halfStep _ 2.0 raisedTo: (1.0 / 12.0). pitch _ aPitch isNumber ifTrue: [aPitch] ifFalse: [self pitchForName: aPitch]. pitch _ pitch / halfStep. ^ (0 to: 14) collect: [:i | pitch _ pitch * halfStep] ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 8/18/1998 11:32'! chromaticRunFrom: startPitch to: endPitch on: aSound "Answer a composite sound consisting of a rapid chromatic run between the given pitches on the given sound." "(AbstractSound chromaticRunFrom: 'c3' to: 'c#5' on: FMSound oboe1) play" | scale halfStep pEnd p | scale _ SequentialSound new. halfStep _ 2.0 raisedTo: (1.0 / 12.0). endPitch isNumber ifTrue: [pEnd _ endPitch asFloat] ifFalse: [pEnd _ AbstractSound pitchForName: endPitch]. startPitch isNumber ifTrue: [p _ startPitch asFloat] ifFalse: [p _ AbstractSound pitchForName: startPitch]. [p <= pEnd] whileTrue: [ scale add: (aSound soundForPitch: p dur: 0.2 loudness: 0.5). p _ p * halfStep]. ^ scale ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:35'! chromaticScale "PluckedSound chromaticScale play" ^ self chromaticScaleOn: self default ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 1/31/98 16:14'! chromaticScaleOn: aSound "PluckedSound chromaticScale play" ^ self noteSequenceOn: aSound from: (((self chromaticPitchesFrom: #c4) copyFrom: 1 to: 13) collect: [:pitch | Array with: pitch with: 0.5 with: 300]) ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:36'! hiMajorScale "FMSound hiMajorScale play" ^ self hiMajorScaleOn: self default ! ! !AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:00'! hiMajorScaleOn: aSound "FMSound hiMajorScale play" ^ self majorScaleOn: aSound from: #c6! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:36'! lowMajorScale "PluckedSound lowMajorScale play" ^ self lowMajorScaleOn: self default ! ! !AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:01'! lowMajorScaleOn: aSound "PluckedSound lowMajorScale play" ^ self majorScaleOn: aSound from: #c3! ! !AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:04'! majorChord "FMSound majorChord play" ^ self majorChordOn: self default from: #c4! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 8/3/1998 17:00'! majorChordOn: aSound from: aPitch "FMSound majorChord play" | score majorScale leadingRest pan note | majorScale _ self majorPitchesFrom: aPitch. score _ MixedSound new. leadingRest _ pan _ 0. #(1 3 5 8) do: [:noteIndex | note _ aSound soundForPitch: (majorScale at: noteIndex) dur: 2.0 - leadingRest loudness: 0.3. score add: (RestSound dur: leadingRest), note pan: pan. leadingRest _ leadingRest + 0.2. pan _ pan + 0.3]. ^ score ! ! !AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 14:45'! majorPitchesFrom: aPitch | chromatic | chromatic _ self chromaticPitchesFrom: aPitch. ^ #(1 3 5 6 8 10 12 13 15 13 12 10 8 6 5 3 1) collect: [:i | chromatic at: i]. ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:34'! majorScale "FMSound majorScale play" ^ self majorScaleOn: self default ! ! !AbstractSound class methodsFor: 'examples' stamp: 'di 1/30/98 16:00'! majorScaleOn: aSound "FMSound majorScale play" ^ self majorScaleOn: aSound from: #c5! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 7/13/1998 13:09'! majorScaleOn: aSound from: aPitch "FMSound majorScale play" ^ self noteSequenceOn: aSound from: ((self majorPitchesFrom: aPitch) collect: [:pitch | Array with: pitch with: 0.5 with: 300]) ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 1/4/1999 09:26'! majorScaleOn: aSound from: aPitch octaves: octaveCount "(AbstractSound majorScaleOn: FMSound oboe1 from: #c2 octaves: 5) play" | startingPitch pitches chromatic | startingPitch _ aPitch isNumber ifTrue: [aPitch] ifFalse: [self pitchForName: aPitch]. pitches _ OrderedCollection new. 0 to: octaveCount - 1 do: [:i | chromatic _ self chromaticPitchesFrom: startingPitch * (2 raisedTo: i). #(1 3 5 6 8 10 12) do: [:j | pitches addLast: (chromatic at: j)]]. pitches addLast: startingPitch * (2 raisedTo: octaveCount). ^ self noteSequenceOn: aSound from: (pitches collect: [:pitch | Array with: pitch with: 0.5 with: 300]) ! ! !AbstractSound class methodsFor: 'examples' stamp: 'jm 1/5/98 17:32'! scaleTest "AbstractSound scaleTest play" ^ MixedSound new add: FMSound majorScale pan: 0; add: (PluckedSound lowMajorScale delayedBy: 0.5) pan: 1.0. ! ! !AbstractSound class methodsFor: 'examples' stamp: 'di 4/13/1999 13:53'! testFMInteractively "Experiment with different settings of the FM modulation and multiplier settings interactively by moving the mouse. The top-left corner of the screen is 0 for both parameters. Stop when the mouse is pressed." "AbstractSound testFMInteractively" | s mousePt lastVal status mod ratio | SoundPlayer startPlayerProcessBufferSize: 1100 rate: 11025 stereo: false. s _ FMSound pitch: 440.0 dur: 200.0 loudness: 0.2. SoundPlayer playSound: s. lastVal _ nil. [Sensor anyButtonPressed] whileFalse: [ mousePt _ Sensor cursorPoint. mousePt ~= lastVal ifTrue: [ mod _ mousePt x asFloat / 20.0. ratio _ mousePt y asFloat / 20.0. s modulation: mod ratio: ratio. lastVal _ mousePt. status _ 'mod: ', mod printString, ' ratio: ', ratio printString. status displayOn: Display at: 10@10]]. SoundPlayer shutDown. ! ! !AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 1/5/98 17:38'! bachFugue "Play a fugue by J. S. Bach using and instance of me as the sound for all four voices." "PluckedSound bachFugue play" ^ self bachFugueOn: self default ! ! !AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 1/5/98 18:27'! bachFugueOn: aSound "Play a fugue by J. S. Bach using the given sound as the sound for all four voices." "PluckedSound bachFugue play" ^ MixedSound new add: (self bachFugueVoice1On: aSound) pan: 1.0; add: (self bachFugueVoice2On: aSound) pan: 0.0; add: (self bachFugueVoice3On: aSound) pan: 1.0; add: (self bachFugueVoice4On: aSound) pan: 0.0. ! ! !AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:51'! bachFugueVoice1On: aSound "Voice one of a fugue by J. S. Bach." ^ self noteSequenceOn: aSound from: #( (1047 0.15 268) (988 0.15 268) (1047 0.30 268) (784 0.30 268) (831 0.30 268) (1047 0.15 268) (988 0.15 268) (1047 0.30 268) (1175 0.30 268) (784 0.30 268) (1047 0.15 268) (988 0.15 268) (1047 0.30 268) (1175 0.30 268) (698 0.15 268) (784 0.15 268) (831 0.60 268) (784 0.15 268) (698 0.15 268) (622 0.15 268) (1047 0.15 268) (988 0.15 268) (880 0.15 268) (784 0.15 268) (698 0.15 268) (622 0.15 268) (587 0.15 268) (523 0.30 268) (1245 0.30 268) (1175 0.30 268) (1047 0.30 268) (932 0.30 268) (880 0.30 268) (932 0.30 268) (1047 0.30 268) (740 0.30 268) (784 0.30 268) (880 0.30 268) (740 0.30 268) (784 0.60 268) (rest 0.15) (523 0.15 268) (587 0.15 268) (622 0.15 268) (698 0.15 268) (784 0.15 268) (831 0.45 268) (587 0.15 268) (622 0.15 268) (698 0.15 268) (784 0.15 268) (880 0.15 268) (932 0.45 268) (622 0.15 268) (698 0.15 268) (784 0.15 268) (831 0.15 268) (784 0.15 268) (698 0.15 268) (622 0.15 268) (587 0.30 268) (1047 0.15 268) (988 0.15 268) (1047 0.60 268) (rest 0.9) (1397 0.30 268) (1245 0.30 268) (1175 0.30 268) (rest 0.3) (831 0.30 268) (784 0.30 268) (698 0.30 268) (784 0.30 268) (698 0.15 268) (622 0.15 268) (698 0.30 268) (587 0.30 268) (784 0.60 268) (rest 0.3) (988 0.30 268) (1047 0.30 268) (1047 0.15 268) (988 0.15 268) (1047 0.30 268) (784 0.30 268) (831 0.60 268) (rest 0.3) (880 0.30 268) (932 0.30 268) (932 0.15 268) (880 0.15 268) (932 0.30 268) (698 0.30 268) (784 0.60 268) (rest 0.3) (784 0.30 268) (831 0.30 268) (831 0.30 268) (784 0.30 268) (698 0.30 268) (rest 0.3) (415 0.30 268) (466 0.30 268) (523 0.30 268) (rest 0.3) (415 0.15 268) (392 0.15 268) (415 0.30 268) (349 0.30 268) (466 0.30 268) (523 0.30 268) (466 0.30 268) (415 0.30 268) (466 0.30 268) (392 0.30 268) (349 0.30 268) (311 0.30 268) (349 0.30 268) (554 0.30 268) (523 0.30 268) (466 0.30 268) (523 0.30 268) (415 0.30 268) (392 0.30 268) (349 0.30 268) (392 0.30 268) (784 0.15 268) (740 0.15 268) (784 0.30 268) (523 0.30 268) (622 0.30 268) (784 0.15 268) (740 0.15 268) (784 0.30 268) (880 0.30 268) (587 0.30 268) (784 0.15 268) (740 0.15 268) (784 0.30 268) (880 0.30 268) (523 0.15 268) (587 0.15 268) (622 0.60 268) (587 0.15 268) (523 0.15 268) (466 0.30 346) (rest 0.45) (587 0.15 346) (659 0.15 346) (740 0.15 346) (784 0.15 346) (880 0.15 346) (932 0.45 346) (659 0.15 346) (698 0.15 346) (784 0.15 346) (880 0.15 346) (932 0.15 346) (1047 0.45 346) (740 0.15 346) (784 0.15 346) (880 0.15 346) (932 0.30 346) (622 0.15 346) (587 0.15 346) (622 0.30 346) (392 0.30 346) (415 0.30 346) (698 0.15 346) (622 0.15 346) (698 0.30 346) (440 0.30 346) (466 0.30 346) (784 0.15 346) (698 0.15 346) (784 0.30 346) (494 0.30 346) (523 0.15 346) (698 0.15 346) (622 0.15 346) (587 0.15 346) (523 0.15 346) (466 0.15 346) (440 0.15 346) (392 0.15 346) (349 0.30 346) (831 0.30 346) (784 0.30 346) (698 0.30 346) (622 0.30 346) (587 0.30 346) (622 0.30 346) (698 0.30 346) (494 0.30 346) (523 0.30 346) (587 0.30 346) (494 0.30 346) (523 0.60 346) (rest 0.3) (659 0.30 346) (698 0.30 346) (698 0.15 346) (659 0.15 346) (698 0.30 346) (523 0.30 346) (587 0.60 346) (rest 0.3) (587 0.30 346) (622 0.30 346) (622 0.15 346) (587 0.15 346) (622 0.30 346) (466 0.30 346) (523 1.20 346) (523 0.30 346) (587 0.15 346) (622 0.15 346) (698 0.15 346) (622 0.15 346) (698 0.15 346) (587 0.15 346) (494 0.30 457) (rest 0.6) (494 0.30 457) (523 0.30 457) (rest 0.6) (622 0.30 457) (587 0.30 457) (rest 0.6) (698 0.60 457) (rest 0.6) (698 0.30 457) (622 0.30 457) (831 0.30 457) (784 0.30 457) (698 0.30 457) (622 0.30 457) (587 0.30 457) (622 0.30 457) (698 0.30 457) (494 0.30 457) (523 0.30 457) (587 0.30 457) (494 0.30 457) (494 0.30 457) (523 0.30 457) (rest 0.3) (523 0.30 457) (698 0.15 457) (587 0.15 457) (622 0.15 457) (523 0.45 457) (494 0.30 457) (523 0.60 457) (rest 0.3) (659 0.30 268) (698 0.60 268) (rest 0.3) (698 0.30 268) (698 0.30 268) (622 0.15 268) (587 0.15 268) (622 0.30 268) (698 0.30 268) (587 0.40 268) (rest 0.4) (587 0.40 268) (rest 0.4) (523 1.60 268)).! ! !AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:52'! bachFugueVoice2On: aSound "Voice two of a fugue by J. S. Bach." ^ self noteSequenceOn: aSound from: #( (rest 4.8) (1568 0.15 346) (1480 0.15 346) (1568 0.30 346) (1047 0.30 346) (1245 0.30 346) (1568 0.15 346) (1480 0.15 346) (1568 0.30 346) (1760 0.30 346) (1175 0.30 346) (1568 0.15 346) (1480 0.15 346) (1568 0.30 346) (1760 0.30 346) (1047 0.15 346) (1175 0.15 346) (1245 0.60 346) (1175 0.15 346) (1047 0.15 346) (932 0.30 346) (1245 0.15 346) (1175 0.15 346) (1245 0.30 346) (784 0.30 346) (831 0.30 346) (1397 0.15 346) (1245 0.15 346) (1397 0.30 346) (880 0.30 346) (932 0.30 346) (1568 0.15 346) (1397 0.15 346) (1568 0.30 346) (988 0.30 346) (1047 0.30 346) (1175 0.15 346) (1245 0.15 346) (1397 0.90 346) (1245 0.15 346) (1175 0.15 346) (1047 0.15 346) (932 0.15 346) (831 0.15 346) (784 0.15 346) (698 0.30 346) (1661 0.30 346) (1568 0.30 346) (1397 0.30 346) (1245 0.30 346) (1175 0.30 346) (1245 0.30 346) (1397 0.30 346) (988 0.30 346) (1047 0.30 346) (1175 0.30 346) (988 0.30 346) (1047 0.30 457) (1568 0.15 457) (1480 0.15 457) (1568 0.30 457) (1175 0.30 457) (1245 0.60 457) (rest 0.3) (1319 0.30 457) (1397 0.30 457) (1397 0.15 457) (1319 0.15 457) (1397 0.30 457) (1047 0.30 457) (1175 0.60 457) (rest 0.3) (1175 0.30 457) (1245 0.30 457) (1245 0.15 457) (1175 0.15 457) (1245 0.30 457) (932 0.30 457) (1047 0.30 457) (1245 0.15 457) (1175 0.15 457) (1245 0.30 457) (1397 0.30 457) (932 0.30 457) (1245 0.15 457) (1175 0.15 457) (1245 0.30 457) (1397 0.30 457) (831 0.15 457) (932 0.15 457) (1047 0.60 457) (932 0.15 457) (831 0.15 457) (784 0.15 457) (622 0.15 457) (698 0.15 457) (784 0.15 457) (831 0.15 457) (932 0.15 457) (1047 0.15 457) (1175 0.15 457) (1245 0.15 457) (1175 0.15 457) (1047 0.15 457) (1175 0.15 457) (1245 0.15 457) (1397 0.15 457) (1568 0.15 457) (1760 0.15 457) (1865 0.15 457) (698 0.15 457) (784 0.15 457) (831 0.15 457) (932 0.15 457) (1047 0.15 457) (1175 0.15 457) (1319 0.15 457) (1397 0.15 457) (1245 0.15 457) (1175 0.15 457) (1245 0.15 457) (1397 0.15 457) (1568 0.15 457) (1760 0.15 457) (1976 0.15 457) (2093 0.30 457) (1976 0.15 457) (1760 0.15 457) (1568 0.15 457) (1397 0.15 457) (1245 0.15 457) (1175 0.15 457) (1047 0.30 457) (1245 0.30 457) (1175 0.30 457) (1047 0.30 457) (932 0.30 457) (880 0.30 457) (932 0.30 457) (1047 0.30 457) (740 0.30 457) (784 0.30 457) (880 0.30 457) (740 0.30 457) (784 0.30 457) (1175 0.15 457) (1047 0.15 457) (1175 0.30 457) (rest 0.6) (1319 0.15 457) (1175 0.15 457) (1319 0.30 457) (rest 0.6) (1480 0.15 457) (1319 0.15 457) (1480 0.30 457) (rest 0.6) (784 0.15 457) (698 0.15 457) (784 0.30 457) (rest 0.6) (880 0.15 457) (784 0.15 457) (880 0.30 457) (rest 0.6) (988 0.15 457) (880 0.15 457) (988 0.30 457) (rest 0.6) (1047 0.15 457) (988 0.15 457) (1047 0.30 457) (784 0.30 457) (831 0.30 457) (1047 0.15 457) (988 0.15 457) (1047 0.30 457) (1175 0.30 457) (784 0.30 457) (1047 0.15 457) (988 0.15 457) (1047 0.30 457) (1175 0.30 457) (698 0.15 457) (784 0.15 457) (831 0.60 457) (784 0.15 457) (698 0.15 457) (622 0.30 457) (1047 0.15 457) (988 0.15 457) (1047 0.30 457) (784 0.30 457) (831 0.60 457) (rest 0.3) (880 0.30 457) (932 0.30 457) (932 0.15 457) (880 0.15 457) (932 0.30 457) (698 0.30 457) (784 0.60 457) (rest 0.3) (784 0.60 457) (831 0.15 457) (932 0.15 457) (1047 0.15 457) (988 0.15 457) (1047 0.15 457) (831 0.15 457) (698 1.20 457) (698 0.30 591) (1175 0.15 591) (1047 0.15 591) (1175 0.30 591) (698 0.30 591) (622 0.30 591) (1245 0.15 591) (1175 0.15 591) (1245 0.30 591) (784 0.30 591) (698 0.30 591) (1397 0.15 591) (1245 0.15 591) (1397 0.30 591) (831 0.30 591) (784 0.15 591) (1397 0.15 591) (1245 0.15 591) (1175 0.15 591) (1047 0.15 591) (988 0.15 591) (880 0.15 591) (784 0.15 591) (1047 0.30 591) (1397 0.30 591) (1245 0.30 591) (1175 0.30 591) (rest 0.3) (831 0.30 591) (784 0.30 591) (698 0.30 591) (784 0.30 591) (698 0.15 591) (622 0.15 591) (698 0.30 591) (587 0.30 591) (831 0.30 591) (784 0.30 591) (rest 0.3) (880 0.30 591) (988 0.30 591) (1047 0.30 591) (698 0.15 591) (622 0.15 591) (587 0.15 591) (523 0.15 591) (523 0.30 591) (1047 0.15 346) (988 0.15 346) (1047 0.30 346) (784 0.30 346) (831 0.30 346) (1047 0.15 346) (988 0.15 346) (1047 0.30 346) (1175 0.30 346) (784 0.30 346) (1047 0.15 346) (988 0.15 346) (1047 0.30 346) (1175 0.30 346) (698 0.20 346) (784 0.20 346) (831 0.80 346) (784 0.20 346) (698 0.20 346) (659 1.60 346)). ! ! !AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:52'! bachFugueVoice3On: aSound "Voice three of a fugue by J. S. Bach." ^ self noteSequenceOn: aSound from: #( (rest 14.4) (523 0.15 457) (494 0.15 457) (523 0.30 457) (392 0.30 457) (415 0.30 457) (523 0.15 457) (494 0.15 457) (523 0.30 457) (587 0.30 457) (392 0.30 457) (523 0.15 457) (494 0.15 457) (523 0.30 457) (587 0.30 457) (349 0.15 457) (392 0.15 457) (415 0.60 457) (392 0.15 457) (349 0.15 457) (311 0.15 457) (523 0.15 457) (494 0.15 457) (440 0.15 457) (392 0.15 457) (349 0.15 457) (311 0.15 457) (294 0.15 457) (262 0.15 457) (294 0.15 457) (311 0.15 457) (294 0.15 457) (262 0.15 457) (233 0.15 457) (208 0.15 457) (196 0.15 457) (175 0.15 457) (466 0.15 457) (415 0.15 457) (392 0.15 457) (349 0.15 457) (311 0.15 457) (294 0.15 457) (262 0.15 457) (233 0.15 457) (262 0.15 457) (294 0.15 457) (262 0.15 457) (233 0.15 457) (208 0.15 457) (196 0.15 457) (175 0.15 457) (156 0.15 457) (415 0.15 457) (392 0.15 457) (349 0.15 457) (311 0.15 457) (277 0.15 457) (262 0.15 457) (233 0.15 457) (208 0.30 457) (523 0.30 457) (466 0.30 457) (415 0.30 457) (392 0.30 457) (349 0.30 457) (392 0.30 457) (415 0.30 457) (294 0.30 457) (311 0.30 457) (349 0.30 457) (294 0.30 457) (311 0.30 457) (415 0.30 457) (392 0.30 457) (349 0.30 457) (392 0.30 457) (311 0.30 457) (294 0.30 457) (262 0.30 457) (294 0.30 457) (466 0.30 457) (415 0.30 457) (392 0.30 457) (415 0.30 457) (349 0.30 457) (311 0.30 457) (294 0.30 457) (311 0.30 457) (rest 1.2) (262 0.30 457) (233 0.30 457) (220 0.30 457) (rest 0.3) (311 0.30 457) (294 0.30 457) (262 0.30 457) (294 0.30 457) (262 0.15 457) (233 0.15 457) (262 0.30 457) (294 0.30 457) (196 0.30 591) (466 0.15 591) (440 0.15 591) (466 0.30 591) (294 0.30 591) (311 0.30 591) (523 0.15 591) (466 0.15 591) (523 0.30 591) (330 0.30 591) (349 0.30 591) (587 0.15 591) (523 0.15 591) (587 0.30 591) (370 0.30 591) (392 0.60 591) (rest 0.15) (196 0.15 591) (220 0.15 591) (247 0.15 591) (262 0.15 591) (294 0.15 591) (311 0.45 591) (220 0.15 591) (233 0.15 591) (262 0.15 591) (294 0.15 591) (311 0.15 591) (349 0.45 591) (247 0.15 591) (262 0.15 591) (294 0.15 591) (311 0.30 591) (rest 0.6) (330 0.30 591) (349 0.30 591) (175 0.30 591) (156 0.30 591) (147 0.30 591) (rest 0.3) (208 0.30 591) (196 0.30 591) (175 0.30 591) (196 0.30 591) (175 0.15 591) (156 0.15 591) (175 0.30 591) (196 0.30 591) (262 0.15 591) (294 0.15 591) (311 0.15 591) (294 0.15 591) (262 0.15 591) (233 0.15 591) (208 0.15 591) (196 0.15 591) (175 0.15 591) (466 0.15 591) (415 0.15 591) (392 0.15 591) (349 0.15 591) (311 0.15 591) (294 0.15 591) (262 0.15 591) (233 0.15 591) (262 0.15 591) (294 0.15 591) (262 0.15 591) (233 0.15 591) (208 0.15 591) (196 0.15 591) (175 0.15 591) (156 0.15 591) (415 0.15 591) (392 0.15 591) (349 0.15 591) (311 0.15 591) (294 0.15 591) (262 0.15 591) (233 0.15 591) (208 0.15 591) (233 0.15 591) (262 0.15 591) (233 0.15 591) (208 0.15 591) (196 0.15 591) (175 0.15 591) (156 0.15 591) (147 0.15 591) (392 0.15 591) (349 0.15 591) (311 0.15 591) (294 0.15 591) (262 0.15 591) (247 0.15 591) (220 0.15 591) (196 0.60 772) (196 0.60 772) (rest 0.15) (196 0.15 772) (220 0.15 772) (247 0.15 772) (262 0.15 772) (294 0.15 772) (311 0.15 772) (349 0.15 772) (392 0.15 772) (349 0.15 772) (415 0.15 772) (392 0.15 772) (349 0.15 772) (311 0.15 772) (294 0.15 772) (262 0.15 772) (247 0.30 772) (262 0.15 772) (494 0.15 772) (262 0.30 772) (196 0.30 772) (208 0.30 772) (262 0.15 772) (247 0.15 772) (262 0.30 772) (294 0.30 772) (196 0.30 772) (262 0.15 772) (247 0.15 772) (262 0.30 772) (294 0.30 772) (175 0.15 772) (196 0.15 772) (208 0.60 772) (196 0.15 772) (175 0.15 772) (156 0.60 772) (rest 0.3) (311 0.30 772) (294 0.30 772) (262 0.30 772) (392 0.30 772) (196 0.30 772) (262 3.60 268) (494 0.40 268) (rest 0.4) (494 0.40 268) (rest 0.4) (392 1.60 268)). ! ! !AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 12/17/97 16:52'! bachFugueVoice4On: aSound "Voice four of a fugue by J. S. Bach." ^ self noteSequenceOn: aSound from: #( (rest 61.2) (131 0.15 500) (123 0.15 500) (131 0.30 500) (98 0.30 500) (104 0.30 500) (131 0.15 500) (123 0.15 500) (131 0.30 500) (147 0.30 500) (98 0.30 500) (131 0.15 500) (123 0.15 500) (131 0.30 500) (147 0.30 500) (87 0.15 500) (98 0.15 500) (104 0.60 500) (98 0.15 500) (87 0.15 500) (78 0.60 500) (rest 0.3) (156 0.30 500) (147 0.30 500) (131 0.30 500) (196 0.30 500) (98 0.30 500) (131 3.60 268) (131 3.20 205)). ! ! !AbstractSound class methodsFor: 'examples-bach fugue' stamp: 'jm 1/5/98 17:45'! stereoBachFugue "Play fugue by J. S. Bach in stereo using different timbres." "AbstractSound stereoBachFugue play" "(AbstractSound bachFugueVoice1On: FMSound flute1) play" "(AbstractSound bachFugueVoice1On: PluckedSound default) play" ^ MixedSound new add: (self bachFugueVoice1On: FMSound oboe1) pan: 0.2; add: (self bachFugueVoice2On: FMSound organ1) pan: 0.8; add: (self bachFugueVoice3On: PluckedSound default) pan: 0.4; add: (self bachFugueVoice4On: FMSound brass1) pan: 0.6. ! ! !AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/14/1998 13:27'! initSounds "AbstractSound initSounds" Sounds _ Dictionary new. (FMSound class organization listAtCategoryNamed: #instruments) do: [:sel | Sounds at: sel asString put: (FMSound perform: sel)]. ! ! !AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/14/1998 13:25'! soundNamed: soundName ^ Sounds at: soundName ! ! !AbstractSound class methodsFor: 'sound library' stamp: 'jm 3/4/98 10:29'! soundNamed: soundName ifAbsent: aBlock ^ Sounds at: soundName ifAbsent: aBlock ! ! !AbstractSound class methodsFor: 'sound library' stamp: 'di 11/7/2000 12:12'! soundNamed: soundName put: aSound Sounds at: soundName put: aSound. AbstractSound updateScorePlayers. ! ! !AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/19/1998 14:11'! soundNames ^ Sounds keys asSortedCollection asArray ! ! !AbstractSound class methodsFor: 'sound library' stamp: 'jm 8/4/1998 18:26'! sounds ^ Sounds ! ! !AbstractSound class methodsFor: 'sound library' stamp: 'jm 1/14/1999 13:00'! updateFMSounds "AbstractSound updateFMSounds" Sounds keys do: [:k | ((Sounds at: k) isKindOf: FMSound) ifTrue: [ Sounds removeKey: k ifAbsent: []]]. (FMSound class organization listAtCategoryNamed: #instruments) do: [:sel | Sounds at: sel asString put: (FMSound perform: sel)]. ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'sge 2/13/2000 05:20'! fileInSoundLibrary "Prompt the user for a file name and the file in the sound library with that name." "AbstractSound fileInSoundLibrary" | fileName | fileName _ FillInTheBlank request: 'Sound library file name?'. fileName isEmptyOrNil ifTrue: [^ self]. (fileName endsWith: '.sounds') ifFalse: [fileName _ fileName, '.sounds']. self fileInSoundLibraryNamed: fileName. ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'di 11/7/2000 12:50'! fileInSoundLibraryNamed: fileName "File in the sound library with the given file name, and add its contents to the current sound library." | s newSounds | s _ FileStream oldFileNamed: fileName. newSounds _ s fileInObjectAndCode. s close. newSounds associationsDo: [:assoc | self storeFiledInSound: assoc value named: assoc key]. AbstractSound updateScorePlayers. Smalltalk garbageCollect. "Large objects may have been released" ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 8/19/1998 12:42'! fileOutSoundLibrary "File out the current sound library." "AbstractSound fileOutSoundLibrary" self fileOutSoundLibrary: Sounds. ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'sge 2/13/2000 05:22'! fileOutSoundLibrary: aDictionary "File out the given dictionary, which is assumed to contain sound and instrument objects keyed by their names." "Note: This method is separated out so that one can file out edited sound libraries, as well as the system sound library. To make such a collection, you can inspect AbstractSound sounds and remove the items you don't want. Then do: 'AbstractSound fileOutSoundLibrary: self' from the Dictionary inspector." | fileName refStream | (aDictionary isKindOf: Dictionary) ifFalse: [self error: 'arg should be a dictionary of sounds']. fileName _ FillInTheBlank request: 'Sound library file name?'. fileName isEmptyOrNil ifTrue: [^ self]. refStream _ SmartRefStream fileNamed: fileName, '.sounds'. refStream nextPut: aDictionary. refStream close. ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/12/1998 21:35'! storeFiledInSound: snd named: sndName "Store the given sound in the sound library. Use the given name if it isn't in use, otherwise ask the user what to do." | menu choice i | (Sounds includesKey: sndName) ifFalse: [ "no name clash" Sounds at: sndName put: snd. ^ self]. (Sounds at: sndName) == UnloadedSnd ifTrue: [ "re-loading a sound that was unloaded to save space" Sounds at: sndName put: snd. ^ self]. "the given sound name is already used" menu _ SelectionMenu selections: #('replace the existing sound' 'rename the new sound' 'skip it'). choice _ menu startUpWithCaption: '"', sndName, '" has the same name as an existing sound'. (choice beginsWith: 'replace') ifTrue: [ Sounds at: sndName put: snd. ^ self]. (choice beginsWith: 'rename') ifTrue: [ i _ 2. [Sounds includesKey: (sndName, ' v', i printString)] whileTrue: [i _ i + 1]. Sounds at: (sndName, ' v', i printString) put: snd]. ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/12/1998 22:18'! unloadSampledTimbres "This can be done to unload those bulky sampled timbres to shrink the image. The unloaded sounds are replaced by a well-known 'unloaded sound' object to enable the unloaded sounds to be detected when the process is reversed." "AbstractSound unloadSampledTimbres" Sounds keys copy do: [:soundName | (((Sounds at: soundName) isKindOf: SampledInstrument) or: [(Sounds at: soundName) isKindOf: LoopedSampledSound]) ifTrue: [ Sounds at: soundName put: self unloadedSound]]. self updateScorePlayers. Smalltalk garbageCollect. ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/11/1998 16:47'! unloadSoundNamed: soundName (Sounds includesKey: soundName) ifTrue: [ Sounds at: soundName put: self unloadedSound]. self updateScorePlayers. ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'jm 9/12/1998 21:48'! unloadedSound "Answer a sound to be used as the place-holder for sounds that have been unloaded." UnloadedSnd ifNil: [UnloadedSnd _ UnloadedSound default copy]. ^ UnloadedSnd ! ! !AbstractSound class methodsFor: 'sound library-file in/out' stamp: 'di 11/7/2000 13:00'! updateScorePlayers | soundsBeingEdited | "Force all ScorePlayers to update their instrument list from the sound library. This may done after loading, unloading, or replacing a sound to make all ScorePlayers feel the change." ScorePlayer allSubInstancesDo: [:p | p pause]. SoundPlayer shutDown. soundsBeingEdited _ EnvelopeEditorMorph allSubInstances collect: [:ed | ed soundBeingEdited]. ScorePlayerMorph allSubInstancesDo: [:p | p updateInstrumentsFromLibraryExcept: soundsBeingEdited]. ! ! !AbstractSound class methodsFor: 'primitive generation' stamp: 'ar 2/3/2001 15:30'! translatedPrimitives ^#( (FMSound mixSampleCount:into:startingAt:leftVol:rightVol:) (PluckedSound mixSampleCount:into:startingAt:leftVol:rightVol:) (LoopedSampledSound mixSampleCount:into:startingAt:leftVol:rightVol:) (SampledSound mixSampleCount:into:startingAt:leftVol:rightVol:) (ReverbSound applyReverbTo:startingAt:count:) ). ! ! PluggableTextMorph subclass: #AcceptableCleanTextMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !AcceptableCleanTextMorph methodsFor: 'as yet unclassified' stamp: 'di 6/22/1998 21:38'! accept "Overridden to allow accept of clean text" | textToAccept ok | textToAccept _ textMorph asText. ok _ (setTextSelector == nil) or: [setTextSelector numArgs = 2 ifTrue: [model perform: setTextSelector with: textToAccept with: self] ifFalse: [model perform: setTextSelector with: textToAccept]]. ok ifTrue: [self setText: self getText. self hasUnacceptedEdits: false]! ! FileDirectory subclass: #AcornFileDirectory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Files'! !AcornFileDirectory methodsFor: 'file name utilities' stamp: 'ar 12/18/1999 00:47'! fullPathFor: path path isEmpty ifTrue:[^pathName]. ((path includes: $$ ) or:[path includes: $:]) ifTrue:[^path]. ^pathName, self slash, path! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AcornFileDirectory class instanceVariableNames: ''! !AcornFileDirectory class methodsFor: 'platform specific' stamp: 'sma 6/25/2000 09:25'! isActiveDirectoryClass "Does this class claim to be that properly active subclass of FileDirectory for the current platform? On Acorn, the test is whether platformName is 'RiscOS' (on newer VMs) or if the primPathNameDelimiter is $. (on older ones), which is what we would like to use for a dirsep if only it would work out. See pathNameDelimiter for more woeful details - then just get on and enjoy Squeak" ^ Smalltalk platformName = 'RiscOS' or: [self primPathNameDelimiter = $.]! ! !AcornFileDirectory class methodsFor: 'platform specific' stamp: 'TPR 7/20/1999 17:52'! maxFileNameLength ^ 255 ! ! !AcornFileDirectory class methodsFor: 'platform specific' stamp: 'TPR 5/10/1998 21:45'! pathNameDelimiter "Acorn RiscOS uses a dot as the directory separator and has no real concept of filename extensions. We tried to make code handle this, but there are just too many uses of dot as a filename extension - so fake it out by pretending to use a slash. The file prims do conversions instead. Sad, but pragmatic" ^ $/ ! ! Object subclass: #Action instanceVariableNames: 'actionTask paused affectedObject lifetime stopCondition myScheduler ' classVariableNames: '' poolDictionaries: '' category: 'Balloon3D-Wonderland Time'! !Action commentStamp: '' prior: 0! This class implements Actions for Wonderlands. An Action is some task that should be executed every frame either forever, until a specified amount of time has elapsed, or until a specified condition holds true. ! !Action methodsFor: 'accessing' stamp: 'jsp 3/9/1999 16:08'! getAffectedObject "Returns the object affected by the action" ^ affectedObject. ! ! !Action methodsFor: 'accessing' stamp: 'jsp 2/1/1999 15:13'! isDone "Returns true if the Action is done executing either because it's lifetime has expired or because the specified condition is true" (lifetime > 0) ifTrue: [^ (lifetime < (myScheduler getTime))] ifFalse: [^ (stopCondition value)]. ! ! !Action methodsFor: 'accessing' stamp: 'jsp 3/9/1999 16:22'! isPaused "Returns true if the action is paused" ^ paused. ! ! !Action methodsFor: 'accessing' stamp: 'jsp 3/9/1999 16:21'! pause "Pause the action" paused _ true. ! ! !Action methodsFor: 'accessing' stamp: 'jsp 3/9/1999 16:21'! resume "resume the action" paused _ false. ! ! !Action methodsFor: 'management' stamp: 'jsp 3/9/1999 16:20'! execute "Execute the Action's task" paused ifFalse: [ actionTask value ]. ! ! !Action methodsFor: 'management' stamp: 'jsp 3/9/1999 16:08'! setAffectedObject: anObject "Sets the object affected by the action" affectedObject _ anObject. ! ! !Action methodsFor: 'management' stamp: 'jsp 2/1/1999 11:44'! setLifetime: howlong andCondition: condition "Sets how long the action should run, or the condition under which it should stop" lifetime _ howlong. stopCondition _ condition. ! ! !Action methodsFor: 'management' stamp: 'jsp 2/1/1999 16:20'! setScheduler: scheduler "Sets the scheduler the Action is active in" myScheduler _ scheduler. ! ! !Action methodsFor: 'management' stamp: 'jsp 3/9/1999 16:20'! setTask: task "Sets the task the Action should perform each frame" actionTask _ task. paused _ false. ! ! !Action methodsFor: 'management' stamp: 'jsp 3/30/1999 11:50'! stop "This method removes the Action from myScheduler's list of active actions" stopCondition _ [ true ]. myScheduler removeAction: self. ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Action class instanceVariableNames: ''! !Action class methodsFor: 'initialize-release' stamp: 'jsp 3/9/1999 16:09'! do: task eachframefor: time toObject: anObject inScheduler: scheduler "Creates a new Action that performs the specified task each frame for (time) seconds" | newAction | newAction _ Action new. newAction setTask: task. newAction setLifetime: (time + (scheduler getTime)) andCondition: [false]. newAction setAffectedObject: anObject. newAction setScheduler: scheduler. scheduler addAction: newAction. ^ newAction. ! ! !Action class methodsFor: 'initialize-release' stamp: 'jsp 3/9/1999 16:09'! do: task eachframeuntil: condition toObject: anObject inScheduler: scheduler "Creates a new Action that performs the specified task each frame until the specified condition holds true" | newAction | newAction _ Action new. newAction setTask: task. newAction setLifetime: -1 andCondition: condition. newAction setAffectedObject: anObject. newAction setScheduler: scheduler. scheduler addAction