[squeak-dev] The Inbox: Sound-mt.89.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:43 UTC 2022
A new version of Sound was added to project The Inbox: http://source.squeak.org/inbox/Sound-mt.89.mcz ==================== Summary ==================== Name: Sound-mt.89 Author: mt Time: 20 April 2022, 11:39:39.081902 am UUID: 9ae530a1-a45a-974e-8cde-2fabc26a4be7 Ancestors: Sound-ct.88 Complements ToolBuilder-Kernel-mt.158 =============== Diff against Sound-ct.88 =============== Item was removed: - SystemOrganization addCategory: #'Sound-Scores'! - SystemOrganization addCategory: #'Sound-Synthesis'! Item was removed: - 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: '<historical>' 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 algorithm 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.) - ! Item was removed: - ----- Method: ADPCMCodec class>>new (in category 'instance creation') ----- - new - - ^ super new - initializeForBitsPerSample: 4 - samplesPerFrame: 0. - ! Item was removed: - ----- Method: ADPCMCodec class>>newBitsPerSample: (in category 'instance creation') ----- - newBitsPerSample: bitsPerSample - - ^ super new - initializeForBitsPerSample: bitsPerSample - samplesPerFrame: 0. - ! Item was removed: - ----- Method: ADPCMCodec class>>translatedPrimitives (in category 'primitive generation') ----- - 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:)) - ! Item was removed: - ----- Method: ADPCMCodec>>bytesPerEncodedFrame (in category 'codec stuff') ----- - 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." - - | bitCount | - frameSizeMask = 0 ifTrue: [^ bitsPerSample]. - "Following assumes mono:" - bitCount := 16 + 6 + ((self samplesPerFrame - 1) * bitsPerSample). - ^ (bitCount + 7) // 8 - ! Item was removed: - ----- Method: ADPCMCodec>>compressAndDecompress: (in category 'codec stuff') ----- - 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 - - ! Item was removed: - ----- Method: ADPCMCodec>>decode:bitsPerSample: (in category 'private') ----- - decode: aByteArray bitsPerSample: bits - - ^ self - decode: aByteArray - sampleCount: (aByteArray size * 8) // bits - bitsPerSample: bits - frameSize: 0 - stereo: false - ! Item was removed: - ----- Method: ADPCMCodec>>decode:sampleCount:bitsPerSample:frameSize:stereo: (in category 'private') ----- - 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] - ! Item was removed: - ----- Method: ADPCMCodec>>decodeFlash:sampleCount:stereo: (in category 'private') ----- - 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]. - ! Item was removed: - ----- Method: ADPCMCodec>>decodeFrames:from:at:into:at: (in category 'codec stuff') ----- - 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)) - ! Item was removed: - ----- Method: ADPCMCodec>>encode:bitsPerSample: (in category 'private') ----- - encode: aSoundBuffer bitsPerSample: bits - - ^ self - encodeLeft: aSoundBuffer - right: nil - bitsPerSample: bits - frameSize: 0 - forFlash: false - ! Item was removed: - ----- Method: ADPCMCodec>>encodeFlashLeft:right:bitsPerSample: (in category 'private') ----- - encodeFlashLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits - - ^ self - encodeLeft: leftSoundBuffer - right: rightSoundBuffer - bitsPerSample: bits - frameSize: 4096 - forFlash: true - ! Item was removed: - ----- Method: ADPCMCodec>>encodeFrames:from:at:into:at: (in category 'codec stuff') ----- - 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)) - ! Item was removed: - ----- Method: ADPCMCodec>>encodeLeft:right:bitsPerSample:frameSize:forFlash: (in category 'private') ----- - encodeLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits frameSize: frameSize forFlash: flashFlag - - | stereoFlag sampleCount sampleBitCount bitCount | - self initializeForBitsPerSample: bits samplesPerFrame: frameSize. - stereoFlag := rightSoundBuffer notNil. - sampleCount := leftSoundBuffer monoSampleCount. - stereoFlag - ifTrue: [sampleBitCount := 2 * (sampleCount * bitsPerSample)] - ifFalse: [sampleBitCount := sampleCount * bitsPerSample]. - bitCount := sampleBitCount + - (self headerBitsForSampleCount: sampleCount stereoFlag: stereoFlag). - - encodedBytes := ByteArray new: ((bitCount / 8) ceiling roundUpTo: self bytesPerEncodedFrame). - byteIndex := 0. - bitPosition := 0. - currentByte := 0. - flashFlag ifTrue: [self nextBits: 2 put: bits - 2]. - stereoFlag - ifTrue: [ - samples := Array with: leftSoundBuffer with: rightSoundBuffer. - sampleIndex := Array with: 0 with: 0. - self privateEncodeStereo: sampleCount] - ifFalse: [ - samples := leftSoundBuffer. - sampleIndex := 0. - self privateEncodeMono: sampleCount]. - - ^ encodedBytes - ! Item was removed: - ----- Method: ADPCMCodec>>headerBitsForSampleCount:stereoFlag: (in category 'private') ----- - 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 - ! Item was removed: - ----- Method: ADPCMCodec>>indexForDeltaFrom:to: (in category 'private') ----- - 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 actually computes the indices used in its frame headers, this algorithm was guessed by reverse-engineering the Flash ADPCM decoder." - - | diff bestIndex | - <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 - ! Item was removed: - ----- Method: ADPCMCodec>>initializeForBitsPerSample:samplesPerFrame: (in category 'private') ----- - 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. - ! Item was removed: - ----- Method: ADPCMCodec>>nextBits: (in category 'bit streaming') ----- - nextBits: n - "Answer the next n bits of my bit stream as an unsigned integer." - - | result remaining shift | - <inline: true> - - result := 0. - remaining := n. - - [ - shift := remaining - bitPosition. - shift > 0 - ifTrue: [ "consumed currentByte buffer; fetch next byte" - result := result + (currentByte << shift). - remaining := remaining - bitPosition. - currentByte := (encodedBytes at: (byteIndex := byteIndex + 1)). - bitPosition := 8] - ifFalse: [ "still some bits left in currentByte buffer" - result := result + (currentByte >> (0 - shift)). - bitPosition := bitPosition - remaining. - "mask out the consumed bits:" - currentByte := currentByte bitAnd: (255 >> (8 - bitPosition)). - ^ result]] repeat - ! Item was removed: - ----- Method: ADPCMCodec>>nextBits:put: (in category 'bit streaming') ----- - nextBits: n put: anInteger - "Write the next n bits to my bit stream." - - | buf bufBits bitsAvailable shift | - <inline: true> - - buf := anInteger. - bufBits := n. - [ - bitsAvailable := 8 - bitPosition. - shift := bitsAvailable - bufBits. "either left or right shift" - "append high bits of buf to end of currentByte:" - shift < 0 - ifTrue: [ "currentByte buffer filled; output it" - currentByte := currentByte + (buf >> (0 - shift)). - encodedBytes at: (byteIndex := byteIndex + 1) put: currentByte. - bitPosition := 0. - currentByte := 0. - "clear saved high bits of buf:" - buf := buf bitAnd: (1 << (0 - shift)) - 1. - bufBits := bufBits - bitsAvailable] - ifFalse: [ "still some bits available in currentByte buffer" - currentByte := currentByte + (buf << shift). - bitPosition := bitPosition + bufBits. - ^ self]] repeat - ! Item was removed: - ----- Method: ADPCMCodec>>privateDecodeMono: (in category 'private') ----- - privateDecodeMono: count - - | delta step predictedDelta bit | - <primitive: 'primitiveDecodeMono' module: 'ADPCMCodecPlugin'> - <var: #stepSizeTable declareC: 'short int *stepSizeTable'> - <var: #indexTable declareC: 'short int *indexTable'> - <var: #samples declareC: 'short int *samples'> - <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]]. - ! Item was removed: - ----- Method: ADPCMCodec>>privateDecodeStereo: (in category 'private') ----- - privateDecodeStereo: count - - | predictedLeft predictedRight indexLeft indexRight deltaLeft deltaRight - stepLeft stepRight predictedDeltaLeft predictedDeltaRight bit | - - <primitive: 'primitiveDecodeStereo' module: 'ADPCMCodecPlugin'> - <var: #stepSizeTable declareC: 'short int *stepSizeTable'> - <var: #indexTable declareC: 'short int *indexTable'> - <var: #samples declareC: 'short int *samples'> - <var: #encodedBytes declareC: 'unsigned char *encodedBytes'> - <var: #rightSamples declareC: 'short int *rightSamples'> - <var: #predicted declareC: 'short int *predicted'> - <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. - ! Item was removed: - ----- Method: ADPCMCodec>>privateEncodeMono: (in category 'private') ----- - privateEncodeMono: count - - | step sign diff delta predictedDelta bit p | - <primitive: 'primitiveEncodeMono' module: 'ADPCMCodecPlugin'> - <var: #stepSizeTable declareC: 'short int *stepSizeTable'> - <var: #indexTable declareC: 'short int *indexTable'> - <var: #samples declareC: 'short int *samples'> - <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]. - ! Item was removed: - ----- Method: ADPCMCodec>>privateEncodeStereo: (in category 'private') ----- - privateEncodeStereo: count - - <primitive: 'primitiveEncodeStereo' module: 'ADPCMCodecPlugin'> - <inline: false> - "not yet implemented" - self success: false.! Item was removed: - ----- Method: ADPCMCodec>>reset (in category 'codec stuff') ----- - reset - - self resetForMono. - ! Item was removed: - ----- Method: ADPCMCodec>>resetForMono (in category 'codec stuff') ----- - resetForMono - "Reset my encoding and decoding state for mono." - - predicted := 0. - index := 0. - ! Item was removed: - ----- Method: ADPCMCodec>>resetForStereo (in category 'codec stuff') ----- - 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. - ! Item was removed: - ----- Method: ADPCMCodec>>samplesPerFrame (in category 'codec stuff') ----- - samplesPerFrame - "Answer the number of sound samples per compression frame." - - frameSizeMask > 0 ifTrue: [^ frameSizeMask + 1]. - ^ 8 "frame size when there are no running headers" - ! Item was removed: - Object subclass: #AIFFFileReader - instanceVariableNames: 'in fileType channelCount frameCount bitsPerSample samplingRate channelData channelDataOffset markers pitch gain isLooped skipDataChunk mergeIfStereo' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !AIFFFileReader commentStamp: '<historical>' 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. - ! Item was removed: - ----- Method: AIFFFileReader>>bitsPerSample (in category 'accessing') ----- - bitsPerSample - - ^ bitsPerSample - ! Item was removed: - ----- Method: AIFFFileReader>>channelCount (in category 'accessing') ----- - channelCount - - ^ channelCount - ! Item was removed: - ----- Method: AIFFFileReader>>channelData (in category 'accessing') ----- - channelData - - ^ channelData - ! Item was removed: - ----- Method: AIFFFileReader>>channelDataOffset (in category 'accessing') ----- - channelDataOffset - - ^ channelDataOffset - ! Item was removed: - ----- Method: AIFFFileReader>>frameCount (in category 'accessing') ----- - frameCount - - ^ frameCount - ! Item was removed: - ----- Method: AIFFFileReader>>gain (in category 'accessing') ----- - gain - - ^ gain - ! Item was removed: - ----- Method: AIFFFileReader>>isLooped (in category 'accessing') ----- - isLooped - - ^ isLooped - ! Item was removed: - ----- Method: AIFFFileReader>>isStereo (in category 'accessing') ----- - isStereo - - ^ channelData size = 2 - ! Item was removed: - ----- Method: AIFFFileReader>>leftSamples (in category 'accessing') ----- - leftSamples - - ^ channelData at: 1 - ! Item was removed: - ----- Method: AIFFFileReader>>loopEnd (in category 'accessing') ----- - loopEnd - ^ markers second last! Item was removed: - ----- Method: AIFFFileReader>>loopLength (in category 'accessing') ----- - loopLength - ^ markers second last - markers first last! Item was removed: - ----- Method: AIFFFileReader>>markers (in category 'accessing') ----- - markers - - ^ markers - ! Item was removed: - ----- Method: AIFFFileReader>>pitch (in category 'accessing') ----- - pitch - - ^ pitch - ! Item was removed: - ----- Method: AIFFFileReader>>pitchForKey: (in category 'other') ----- - 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) - ! Item was removed: - ----- Method: AIFFFileReader>>readChunk:size: (in category 'private') ----- - 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" - ! Item was removed: - ----- Method: AIFFFileReader>>readCommonChunk: (in category 'private') ----- - 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" - ! Item was removed: - ----- Method: AIFFFileReader>>readExtendedFloat (in category 'private') ----- - 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 - ! Item was removed: - ----- Method: AIFFFileReader>>readFrom: (in category 'private') ----- - 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" - ! Item was removed: - ----- Method: AIFFFileReader>>readFromFile: (in category 'reading') ----- - readFromFile: fileName - "Read the AIFF file of the given name." - "AIFFFileReader new readFromFile: 'test.aiff'" - - self readFromFile: fileName - mergeIfStereo: false - skipDataChunk: false. - ! Item was removed: - ----- Method: AIFFFileReader>>readFromFile:mergeIfStereo:skipDataChunk: (in category 'reading') ----- - readFromFile: fileName mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag - "Read the AIFF file of the given name. See comment in readFromStream:mergeIfStereo:skipDataChunk:." - "AIFFFileReader new readFromFile: 'test.aiff' mergeIfStereo: false skipDataChunk: true" - - | f | - f := (FileStream readOnlyFileNamed: fileName) binary. - self readFromStream: f mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag. - f close. - ! Item was removed: - ----- Method: AIFFFileReader>>readFromStream:mergeIfStereo:skipDataChunk: (in category 'reading') ----- - readFromStream: aBinaryStream mergeIfStereo: mergeFlag skipDataChunk: skipDataFlag - "Read an AIFF file from the given binary stream. 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." - - mergeIfStereo := mergeFlag. - skipDataChunk := skipDataFlag. - isLooped := false. - gain := 1.0. - self readFrom: aBinaryStream. - ! Item was removed: - ----- Method: AIFFFileReader>>readInstrumentChunk: (in category 'private') ----- - 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 second last > frameCount]) - ifTrue: ["bad loop data; some sample CD files claim to be - looped but aren't" - isLooped := false]]. - pitch := self pitchForKey: midiKey! Item was removed: - ----- Method: AIFFFileReader>>readMarkerChunk: (in category 'private') ----- - 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)]. - - ! Item was removed: - ----- Method: AIFFFileReader>>readMergedStereoChannelDataFrom: (in category 'private') ----- - 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)]]. - ! Item was removed: - ----- Method: AIFFFileReader>>readMonoChannelDataFrom: (in category 'private') ----- - 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]]. - ! Item was removed: - ----- Method: AIFFFileReader>>readMultiChannelDataFrom: (in category 'private') ----- - 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]]]. - ! Item was removed: - ----- Method: AIFFFileReader>>readSamplesChunk: (in category 'private') ----- - readSamplesChunk: chunkSize - "Read a SSND chunk. All AIFF files with a non-zero frameCount contain exactly one chunk of this type." - - | offset blockSize bytesOfSamples s | - offset := in nextNumber: 4. - blockSize := in nextNumber: 4. - ((offset ~= 0) or: [blockSize ~= 0]) - ifTrue: [^ self error: 'this AIFF reader cannot handle blocked sample chunks']. - bytesOfSamples := chunkSize - 8. - bytesOfSamples = (channelCount * frameCount * (bitsPerSample // 8)) - ifFalse: [self error: 'actual sample count does not match COMM chunk']. - - channelDataOffset := in position. "record stream position for start of data" - skipDataChunk ifTrue: [in skip: (chunkSize - 8). ^ self]. "if skipDataChunk, skip sample data" - - (mergeIfStereo and: [channelCount = 2]) - ifTrue: [ - channelData := Array with: (SoundBuffer newMonoSampleCount: frameCount)] - ifFalse: [ - channelData := - (1 to: channelCount) collect: [:i | SoundBuffer newMonoSampleCount: frameCount]]. - - (bytesOfSamples < (Smalltalk garbageCollectMost - 300000)) - ifTrue: [s := ReadStream on: (in next: bytesOfSamples)] "bulk-read, then process" - ifFalse: [s := in]. "not enough space to buffer; read directly from file" - - "mono and stereo are special-cased for better performance" - channelCount = 1 ifTrue: [^ self readMonoChannelDataFrom: s]. - channelCount = 2 ifTrue: [ - mergeIfStereo - ifTrue: [channelCount := 1. ^ self readMergedStereoChannelDataFrom: s] - ifFalse: [^ self readStereoChannelDataFrom: s]]. - self readMultiChannelDataFrom: s. - ! Item was removed: - ----- Method: AIFFFileReader>>readStereoChannelDataFrom: (in category 'private') ----- - 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]]. - ! Item was removed: - ----- Method: AIFFFileReader>>rightSamples (in category 'accessing') ----- - rightSamples - - ^ channelData at: 2 - ! Item was removed: - ----- Method: AIFFFileReader>>samplingRate (in category 'accessing') ----- - samplingRate - - ^ samplingRate - ! Item was removed: - ----- Method: AIFFFileReader>>sound (in category 'other') ----- - 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 - ! Item was removed: - Object subclass: #AbstractScoreEvent - instanceVariableNames: 'time' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !AbstractScoreEvent commentStamp: '<historical>' prior: 0! - Abstract class for timed events in a MIDI score. - ! Item was removed: - ----- Method: AbstractScoreEvent>>adjustTimeBy: (in category 'accessing') ----- - adjustTimeBy: delta - - time := time + delta - ! Item was removed: - ----- Method: AbstractScoreEvent>>endTime (in category 'accessing') ----- - endTime - "Subclasses should override to return the ending time if the event has some duration." - - ^ time - ! Item was removed: - ----- Method: AbstractScoreEvent>>isControlChange (in category 'classification') ----- - isControlChange - - ^ false - ! Item was removed: - ----- Method: AbstractScoreEvent>>isNoteEvent (in category 'classification') ----- - isNoteEvent - - ^ false - ! Item was removed: - ----- Method: AbstractScoreEvent>>isPitchBend (in category 'classification') ----- - isPitchBend - - ^ false - ! Item was removed: - ----- Method: AbstractScoreEvent>>isProgramChange (in category 'classification') ----- - isProgramChange - - ^ false - ! Item was removed: - ----- Method: AbstractScoreEvent>>isTempoEvent (in category 'classification') ----- - isTempoEvent - - ^ false - ! Item was removed: - ----- Method: AbstractScoreEvent>>outputOnMidiPort: (in category 'midi') ----- - outputOnMidiPort: aMidiPort - "Output this event to the given MIDI port. This default implementation does nothing." - ! Item was removed: - ----- Method: AbstractScoreEvent>>time (in category 'accessing') ----- - time - - ^ time - ! Item was removed: - ----- Method: AbstractScoreEvent>>time: (in category 'accessing') ----- - time: aNumber - - time := aNumber. - ! Item was removed: - Object subclass: #AbstractSound - instanceVariableNames: 'envelopes mSecsSinceStart samplesUntilNextControl scaledVol scaledVolIncr scaledVolLimit' - classVariableNames: 'FloatScaleFactor MaxScaledValue PitchesForBottomOctave ScaleFactor Sounds TopOfBottomOctave UnloadedSnd' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: AbstractSound class>>bachFugue (in category 'examples-bach fugue BWV847') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound class>>bachFugueOn: (in category 'examples-bach fugue BWV847') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound class>>bachFugueVoice1On: (in category 'examples-bach fugue BWV847') ----- - 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)).! Item was removed: - ----- Method: AbstractSound class>>bachFugueVoice2On: (in category 'examples-bach fugue BWV847') ----- - 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)). - ! Item was removed: - ----- Method: AbstractSound class>>bachFugueVoice3On: (in category 'examples-bach fugue BWV847') ----- - 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)). - ! Item was removed: - ----- Method: AbstractSound class>>bachFugueVoice4On: (in category 'examples-bach fugue BWV847') ----- - 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)). - ! Item was removed: - ----- Method: AbstractSound class>>busySignal: (in category 'utilities') ----- - 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. - - ! Item was removed: - ----- Method: AbstractSound class>>chromaticPitchesFrom: (in category 'examples') ----- - 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] - ! Item was removed: - ----- Method: AbstractSound class>>chromaticRunFrom:to:on: (in category 'examples') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound class>>chromaticScale (in category 'examples') ----- - chromaticScale - "PluckedSound chromaticScale play" - - ^ self chromaticScaleOn: self default - ! Item was removed: - ----- Method: AbstractSound class>>chromaticScaleOn: (in category 'examples') ----- - 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]) - ! Item was removed: - ----- Method: AbstractSound class>>default (in category 'instance creation') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound class>>dial: (in category 'utilities') ----- - dial: aString - | s | - "AbstractSound dial: '867-5309'" "ask for Jenny" - - s := SequentialSound new. - aString do: [ :c | | lo m index hi | - 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. - - ! Item was removed: - ----- Method: AbstractSound class>>dialTone: (in category 'utilities') ----- - 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! Item was removed: - ----- Method: AbstractSound class>>dur: (in category 'instance creation') ----- - dur: d - "Return a rest of the given duration." - - ^ self basicNew setDur: d - ! Item was removed: - ----- Method: AbstractSound class>>fileInSoundLibrary (in category 'sound library-file in/out') ----- - fileInSoundLibrary - "Prompt the user for a file name and the file in the sound library with that name." - "AbstractSound fileInSoundLibrary" - - | fileName | - fileName := UIManager default request: 'Sound library file name?'. - fileName isEmptyOrNil ifTrue: [^ self]. - (fileName endsWith: '.sounds') ifFalse: [fileName := fileName, '.sounds']. - self fileInSoundLibraryNamed: fileName. - ! Item was removed: - ----- Method: AbstractSound class>>fileInSoundLibraryNamed: (in category 'sound library-file in/out') ----- - 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 readOnlyFileNamed: 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" - ! Item was removed: - ----- Method: AbstractSound class>>fileOutSoundLibrary (in category 'sound library-file in/out') ----- - fileOutSoundLibrary - "File out the current sound library." - "AbstractSound fileOutSoundLibrary" - - self fileOutSoundLibrary: Sounds. - ! Item was removed: - ----- Method: AbstractSound class>>fileOutSoundLibrary: (in category 'sound library-file in/out') ----- - 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 := UIManager default request: 'Sound library file name?'. - fileName isEmptyOrNil ifTrue: [^ self]. - refStream := SmartRefStream fileNamed: fileName, '.sounds'. - refStream nextPut: aDictionary. - refStream close. - ! Item was removed: - ----- Method: AbstractSound class>>hangUpWarning: (in category 'utilities') ----- - 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 - - ! Item was removed: - ----- Method: AbstractSound class>>hiMajorScale (in category 'examples') ----- - hiMajorScale - "FMSound hiMajorScale play" - - ^ self hiMajorScaleOn: self default - ! Item was removed: - ----- Method: AbstractSound class>>hiMajorScaleOn: (in category 'examples') ----- - hiMajorScaleOn: aSound - "FMSound hiMajorScale play" - - ^ self majorScaleOn: aSound from: #c6! Item was removed: - ----- Method: AbstractSound class>>indexOfBottomOctavePitch: (in category 'utilities') ----- - 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'. - ! Item was removed: - ----- Method: AbstractSound class>>initSounds (in category 'sound library') ----- - initSounds - "AbstractSound initSounds" - - Sounds := Dictionary new. - (FMSound class organization listAtCategoryNamed: #instruments) - do: [:sel | Sounds at: sel asString put: (FMSound perform: sel)]. - ! Item was removed: - ----- Method: AbstractSound class>>initialize (in category 'class initialization') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound class>>lowMajorScale (in category 'examples') ----- - lowMajorScale - "PluckedSound lowMajorScale play" - - ^ self lowMajorScaleOn: self default - ! Item was removed: - ----- Method: AbstractSound class>>lowMajorScaleOn: (in category 'examples') ----- - lowMajorScaleOn: aSound - "PluckedSound lowMajorScale play" - - ^ self majorScaleOn: aSound from: #c3! Item was removed: - ----- Method: AbstractSound class>>majorChord (in category 'examples') ----- - majorChord - "FMSound majorChord play" - ^ self majorChordOn: self default from: #c4! Item was removed: - ----- Method: AbstractSound class>>majorChordOn:from: (in category 'examples') ----- - majorChordOn: aSound from: aPitch - "FMSound majorChord play" - - | score majorScale leadingRest pan | - majorScale := self majorPitchesFrom: aPitch. - score := MixedSound new. - leadingRest := pan := 0. - #(1 3 5 8) do: [:noteIndex | | note | - 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 - ! Item was removed: - ----- Method: AbstractSound class>>majorPitchesFrom: (in category 'examples') ----- - 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]. - ! Item was removed: - ----- Method: AbstractSound class>>majorScale (in category 'examples') ----- - majorScale - "FMSound majorScale play" - - ^ self majorScaleOn: self default - ! Item was removed: - ----- Method: AbstractSound class>>majorScaleOn: (in category 'examples') ----- - majorScaleOn: aSound - "FMSound majorScale play" - - ^ self majorScaleOn: aSound from: #c5! Item was removed: - ----- Method: AbstractSound class>>majorScaleOn:from: (in category 'examples') ----- - majorScaleOn: aSound from: aPitch - "FMSound majorScale play" - - ^ self noteSequenceOn: aSound - from: ((self majorPitchesFrom: aPitch) - collect: [:pitch | Array with: pitch with: 0.5 with: 300]) - ! Item was removed: - ----- Method: AbstractSound class>>majorScaleOn:from:octaves: (in category 'examples') ----- - 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]) - ! Item was removed: - ----- Method: AbstractSound class>>midiKeyForPitch: (in category 'utilities') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound class>>noteSequenceOn:from: (in category 'instance creation') ----- - 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 | - score := SequentialSound new. - anArray do: [:el | | pitch | - 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 - ! Item was removed: - ----- Method: AbstractSound class>>pitch:dur:loudness: (in category 'instance creation') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound class>>pitchForMIDIKey: (in category 'utilities') ----- - 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) - ! Item was removed: - ----- Method: AbstractSound class>>pitchForName: (in category '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 - ! Item was removed: - ----- Method: AbstractSound class>>pitchTable (in category 'utilities') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound class>>scaleFactor (in category 'class initialization') ----- - scaleFactor - - ^ ScaleFactor - ! Item was removed: - ----- Method: AbstractSound class>>scaleTest (in category 'examples') ----- - scaleTest - "AbstractSound scaleTest play" - - ^ MixedSound new - add: FMSound majorScale pan: 0; - add: (PluckedSound lowMajorScale delayedBy: 0.5) pan: 1.0. - ! Item was removed: - ----- Method: AbstractSound class>>soundNamed: (in category 'sound library') ----- - soundNamed: soundName - - ^ Sounds at: soundName - ! Item was removed: - ----- Method: AbstractSound class>>soundNamed:ifAbsent: (in category 'sound library') ----- - soundNamed: soundName ifAbsent: aBlock - - ^ Sounds at: soundName ifAbsent: aBlock - ! Item was removed: - ----- Method: AbstractSound class>>soundNamed:put: (in category 'sound library') ----- - soundNamed: soundName put: aSound - - Sounds at: soundName put: aSound. - AbstractSound updateScorePlayers. - ! Item was removed: - ----- Method: AbstractSound class>>soundNames (in category 'sound library') ----- - soundNames - - "AbstractSound soundNames asSortedCollection do: - [:n | - (n padded: #right to: 10 with: $ ) asParagraph displayAt: Sensor cursorPoint - 32. - (AbstractSound soundNamed: n) ifNotNil: - [:s| s playAndWaitUntilDone. (Delay forMilliseconds: 250) wait]]" - - ^ Sounds keys asArray sort - ! Item was removed: - ----- Method: AbstractSound class>>sounds (in category 'sound library') ----- - sounds - - ^ Sounds - ! Item was removed: - ----- Method: AbstractSound class>>stereoBachFugue (in category 'examples-bach fugue BWV847') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound class>>storeFiledInSound:named: (in category 'sound library-file in/out') ----- - 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." - - | 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" - choice := UIManager default - chooseFrom: #('replace the existing sound' 'rename the new sound' 'skip it') - values: #('replace the existing sound' 'rename the new sound' 'skip it') - title: '"', 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]. - ! Item was removed: - ----- Method: AbstractSound class>>testFMInteractively (in category 'examples') ----- - 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 at 10]]. - - SoundPlayer shutDown: true. - ! Item was removed: - ----- Method: AbstractSound class>>translatedPrimitives (in category 'primitive generation') ----- - 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:) - ). - ! Item was removed: - ----- Method: AbstractSound class>>unloadSampledTimbres (in category 'sound library-file in/out') ----- - 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 do: [:soundName | - (((Sounds at: soundName) isKindOf: SampledInstrument) or: - [(Sounds at: soundName) isKindOf: LoopedSampledSound]) ifTrue: [ - Sounds at: soundName put: self unloadedSound]]. - self updateScorePlayers. - Smalltalk garbageCollect. - ! Item was removed: - ----- Method: AbstractSound class>>unloadSoundNamed: (in category 'sound library-file in/out') ----- - unloadSoundNamed: soundName - - (Sounds includesKey: soundName) ifTrue: [ - Sounds at: soundName put: self unloadedSound]. - self updateScorePlayers. - ! Item was removed: - ----- Method: AbstractSound class>>unloadedSound (in category 'sound library-file in/out') ----- - unloadedSound - "Answer a sound to be used as the place-holder for sounds that have been unloaded." - - UnloadedSnd ifNil: [UnloadedSnd := UnloadedSound default copy]. - ^ UnloadedSnd - ! Item was removed: - ----- Method: AbstractSound class>>updateFMSounds (in category 'sound library') ----- - 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)]. - ! Item was removed: - ----- Method: AbstractSound>>+ (in category 'composition') ----- - + aSound - "Return the mix of the receiver and the argument sound." - - ^(MixedSound new) - add: self; - add: aSound; - yourself - ! Item was removed: - ----- Method: AbstractSound>>, (in category 'composition') ----- - , aSound - "Return the concatenation of the receiver and the argument sound." - - ^(SequentialSound new) - add: self; - add: aSound; - yourself! Item was removed: - ----- Method: AbstractSound>>addEnvelope: (in category 'envelopes') ----- - addEnvelope: anEnvelope - "Add the given envelope to my envelopes list." - - anEnvelope target: self. - envelopes := envelopes copyWith: anEnvelope. - ! Item was removed: - ----- Method: AbstractSound>>adjustVolumeTo:overMSecs: (in category 'volume') ----- - 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)]. - ! Item was removed: - ----- Method: AbstractSound>>asSampledSound (in category 'conversion') ----- - asSampledSound - "Answer a SampledSound containing my samples. If the receiver is some kind of sampled sound, the resulting SampledSound will have the same original sampling rate as the receiver." - - ^ SampledSound samples: self samples samplingRate: self originalSamplingRate - ! Item was removed: - ----- Method: AbstractSound>>asSound (in category 'composition') ----- - asSound - - ^ self - ! Item was removed: - ----- Method: AbstractSound>>computeSamplesForSeconds: (in category 'playing') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound>>controlRate (in category 'sampling rates') ----- - controlRate - "Answer the number of control changes per second." - - ^ 100 - ! Item was removed: - ----- Method: AbstractSound>>copyEnvelopes (in category 'copying') ----- - copyEnvelopes - "Private!! Support for copying. Copy my envelopes." - - envelopes := envelopes collect: [:e | e copy target: self]. - ! Item was removed: - ----- Method: AbstractSound>>delayedBy: (in category 'composition') ----- - delayedBy: seconds - "Return a composite sound consisting of a rest for the given amount of time followed by the receiver." - - ^ (RestSound dur: seconds), self - ! Item was removed: - ----- Method: AbstractSound>>doControl (in category 'sound generation') ----- - 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). - ! Item was removed: - ----- Method: AbstractSound>>duration: (in category 'initialization') ----- - 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]. - ! Item was removed: - ----- Method: AbstractSound>>envelopes (in category 'envelopes') ----- - envelopes - "Return my collection of envelopes." - - ^ envelopes - ! Item was removed: - ----- Method: AbstractSound>>initialVolume: (in category 'volume') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound>>initialize (in category 'initialization') ----- - initialize - super initialize. - envelopes := #(). - mSecsSinceStart := 0. - samplesUntilNextControl := 0. - scaledVol := (1.0 * ScaleFactor) rounded. - scaledVolIncr := 0. - scaledVolLimit := scaledVol. - ! Item was removed: - ----- Method: AbstractSound>>internalizeModulationAndRatio (in category 'sound generation') ----- - internalizeModulationAndRatio - "Overridden by FMSound. This default implementation does nothing." - ! Item was removed: - ----- Method: AbstractSound>>isPlaying (in category 'playing') ----- - isPlaying - "Return true if the receiver is currently playing" - ^ SoundPlayer isPlaying: self! Item was removed: - ----- Method: AbstractSound>>isStereo (in category 'accessing') ----- - isStereo - "Answer true if this sound has distinct left and right channels. (Every sound plays into a stereo sample buffer, but most sounds, which produce exactly the same samples on both channels, are not stereo.)" - - ^ false - ! Item was removed: - ----- Method: AbstractSound>>loudness (in category 'volume') ----- - loudness - "Answer the current volume setting for this sound." - - ^ envelopes detect: [:e | e isKindOf: VolumeEnvelope] - ifFound: [ :envelope | envelope scale ] - ifNone: [scaledVol asFloat / FloatScaleFactor] - ! Item was removed: - ----- Method: AbstractSound>>loudness: (in category 'initialization') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound>>millisecondsSinceStart (in category 'playing') ----- - millisecondsSinceStart - - ^ mSecsSinceStart! Item was removed: - ----- Method: AbstractSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound>>nameOrNumberToPitch: (in category 'initialization') ----- - 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] - ! Item was removed: - ----- Method: AbstractSound>>originalSamplingRate (in category 'sampling rates') ----- - originalSamplingRate - "For sampled sounds, answer the sampling rate used to record the stored samples. For other sounds, this is the same as the playback sampling rate." - - ^ SoundPlayer samplingRate - ! Item was removed: - ----- Method: AbstractSound>>pause (in category 'playing') ----- - pause - "Pause this sound. It can be resumed from this point, or reset and resumed to start from the beginning." - - SoundPlayer pauseSound: self.! Item was removed: - ----- Method: AbstractSound>>play (in category 'playing') ----- - play - "Play this sound to the sound output port in real time. Use the sound service to check for sound preferences." - - SoundService playSound: self.! Item was removed: - ----- Method: AbstractSound>>playAndWaitUntilDone (in category 'playing') ----- - playAndWaitUntilDone - "Play this sound to the sound ouput port and wait until it has finished playing before returning." - - | duration timeTaken delay | - duration := [self duration] on: MessageNotUnderstood do: [:ex| SmallInteger maxVal]. - timeTaken := Time utcMicrosecondClock. - self play. - timeTaken := Time utcMicrosecondClock - timeTaken // 1000. - duration > timeTaken ifTrue: - [delay := Delay forMilliseconds: (SoundPlayer bufferMSecs min: duration - timeTaken). - [self samplesRemaining > 0] whileTrue: [delay wait]]. - (Delay forMilliseconds: SoundPlayer bufferMSecs) wait "ensure last buffer has been output" - - "AndreasSystemProfiler spyOn: [PluckedSound bachFugue playAndWaitUntilDone]"! Item was removed: - ----- Method: AbstractSound>>playChromaticRunFrom:to: (in category 'playing') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound>>playSampleCount:into:startingAt: (in category 'playing') ----- - 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]. - ! Item was removed: - ----- Method: AbstractSound>>playSilently (in category 'playing') ----- - 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]. - ! Item was removed: - ----- Method: AbstractSound>>playSilentlyUntil: (in category 'playing') ----- - 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]. - ! Item was removed: - ----- Method: AbstractSound>>postCopy (in category 'copying') ----- - postCopy - "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." - - super postCopy. - self copyEnvelopes - ! Item was removed: - ----- Method: AbstractSound>>removeAllEnvelopes (in category 'envelopes') ----- - removeAllEnvelopes - "Remove all envelopes from my envelopes list." - - envelopes := #(). - ! Item was removed: - ----- Method: AbstractSound>>removeEnvelope: (in category 'envelopes') ----- - removeEnvelope: anEnvelope - "Remove the given envelope from my envelopes list." - - envelopes := envelopes copyWithout: anEnvelope. - ! Item was removed: - ----- Method: AbstractSound>>reset (in category 'sound generation') ----- - 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]]. - ! Item was removed: - ----- Method: AbstractSound>>resumePlaying (in category 'playing') ----- - resumePlaying - "Resume playing this sound from where it last stopped." - - SoundPlayer resumePlaying: self. - ! Item was removed: - ----- Method: AbstractSound>>samples (in category 'playing') ----- - samples - "Answer a monophonic sample buffer containing my samples. The left and write channels are merged." - "Warning: This may require a lot of memory!!" - - ^ (self computeSamplesForSeconds: self duration) mergeStereo - ! Item was removed: - ----- Method: AbstractSound>>samplesRemaining (in category 'sound generation') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound>>samplingRate (in category 'sampling rates') ----- - samplingRate - "Answer the sampling rate in samples per second." - - ^ SoundPlayer samplingRate - ! Item was removed: - ----- Method: AbstractSound>>setPitch:dur:loudness: (in category 'initialization') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound>>soundForMidiKey:dur:loudness: (in category 'initialization') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound>>soundForPitch:dur:loudness: (in category 'initialization') ----- - 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 - ! Item was removed: - ----- Method: AbstractSound>>sounds (in category 'copying') ----- - sounds - "Allows simple sounds to behave as, eg, sequential sounds" - - ^ Array with: self! Item was removed: - ----- Method: AbstractSound>>stopAfterMSecs: (in category 'sound generation') ----- - stopAfterMSecs: mSecs - "Terminate this sound this note after the given number of milliseconds. This default implementation does nothing." - ! Item was removed: - ----- Method: AbstractSound>>stopGracefully (in category 'sound generation') ----- - 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. - ! Item was removed: - ----- Method: AbstractSound>>storeAIFFOnFileNamed: (in category 'file i/o') ----- - storeAIFFOnFileNamed: fileName - "Store this sound as a AIFF file of the given name." - - | f | - f := (FileStream fileNamed: fileName) binary. - self storeAIFFSamplesOn: f. - f close. - ! Item was removed: - ----- Method: AbstractSound>>storeAIFFSamplesOn: (in category 'file i/o') ----- - storeAIFFSamplesOn: aBinaryStream - "Store this sound as a 16-bit AIFF file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound." - - | samplesToStore channelCount dataByteCount | - samplesToStore := (self duration * self samplingRate) ceiling. - channelCount := self isStereo ifTrue: [2] ifFalse: [1]. - dataByteCount := samplesToStore * channelCount * 2. - - "write AIFF file header:" - aBinaryStream nextPutAll: 'FORM' asByteArray. - aBinaryStream nextInt32Put: ((7 * 4) + 18) + dataByteCount. - aBinaryStream nextPutAll: 'AIFF' asByteArray. - aBinaryStream nextPutAll: 'COMM' asByteArray. - aBinaryStream nextInt32Put: 18. - aBinaryStream nextNumber: 2 put: channelCount. - aBinaryStream nextInt32Put: samplesToStore. - aBinaryStream nextNumber: 2 put: 16. "bits/sample" - self storeExtendedFloat: self samplingRate on: aBinaryStream. - aBinaryStream nextPutAll: 'SSND' asByteArray. - aBinaryStream nextInt32Put: dataByteCount + 8. - aBinaryStream nextInt32Put: 0. - aBinaryStream nextInt32Put: 0. - - "write data:" - self storeSampleCount: samplesToStore bigEndian: true on: aBinaryStream. - ! Item was removed: - ----- Method: AbstractSound>>storeExtendedFloat:on: (in category 'file i/o') ----- - 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)]. - ! Item was removed: - ----- Method: AbstractSound>>storeSample:in:at:leftVol:rightVol: (in category 'sound generation') ----- - 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]. - ! Item was removed: - ----- Method: AbstractSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- - storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream - "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files). If self isStereo is true, both channels are stored, creating a stereo file. Otherwise, only the left channel is stored, creating a mono file." - - | bufSize stereoBuffer reverseBytes streamDirect | - self reset. - bufSize := (2 * self samplingRate rounded) min: samplesToStore. "two second buffer" - stereoBuffer := SoundBuffer newStereoSampleCount: bufSize. - streamDirect := aBinaryStream isKindOf: StandardFileStream. - reverseBytes := (bigEndianFlag xor: Smalltalk isBigEndian) xor: streamDirect not. - - 'Storing audio...' - displayProgressFrom: 0 to: samplesToStore during: [:bar | | remaining out | - remaining := samplesToStore. - [remaining > 0] whileTrue: [ - bar value: samplesToStore - remaining. - stereoBuffer primFill: 0. "clear the buffer" - self playSampleCount: (bufSize min: remaining) into: stereoBuffer startingAt: 1. - out := self isStereo - ifTrue: [stereoBuffer] - ifFalse: [stereoBuffer extractLeftChannel]. - reverseBytes ifTrue: [out reverseEndianness]. - streamDirect - ifTrue: [ "optimization for files: write sound buffer directly to file" - aBinaryStream next: (out size // 2) putAll: out startingAt: 1] "size in words" - ifFalse: [ "for non-file streams:" - 1 to: out monoSampleCount do: [:i | aBinaryStream int16: (out at: i)]]. - remaining := remaining - bufSize]].! Item was removed: - ----- Method: AbstractSound>>storeSunAudioOnFileNamed: (in category 'file i/o') ----- - storeSunAudioOnFileNamed: fileName - "Store this sound as an uncompressed Sun audio file of the given name." - - | f | - f := (FileStream fileNamed: fileName) binary. - self storeSunAudioSamplesOn: f. - f close. - ! Item was removed: - ----- Method: AbstractSound>>storeSunAudioSamplesOn: (in category 'file i/o') ----- - storeSunAudioSamplesOn: aBinaryStream - "Store this sound as a 16-bit Sun audio file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound." - - - | samplesToStore channelCount dataByteCount | - samplesToStore := (self duration * self samplingRate) ceiling. - channelCount := self isStereo ifTrue: [2] ifFalse: [1]. - dataByteCount := samplesToStore * channelCount * 2. - - "write Sun audio file header" - channelCount := self isStereo ifTrue: [2] ifFalse: [1]. - aBinaryStream nextPutAll: '.snd' asByteArray. - aBinaryStream uint32: 24. "header size in bytes" - aBinaryStream uint32: dataByteCount. - aBinaryStream uint32: 3. "format: 16-bit linear" - aBinaryStream uint32: self samplingRate truncated. - aBinaryStream uint32: channelCount. - - "write data:" - self storeSampleCount: samplesToStore bigEndian: true on: aBinaryStream. - ! Item was removed: - ----- Method: AbstractSound>>storeWAVOnFileNamed: (in category 'file i/o') ----- - storeWAVOnFileNamed: fileName - "Store this sound as a 16-bit Windows WAV file of the given name." - - | f | - f := (FileStream fileNamed: fileName) binary. - self storeWAVSamplesOn: f. - f close. - ! Item was removed: - ----- Method: AbstractSound>>storeWAVSamplesOn: (in category 'file i/o') ----- - storeWAVSamplesOn: aBinaryStream - "Store this sound as a 16-bit Windows WAV file at the current SoundPlayer sampling rate. Store both channels if self isStereo is true; otherwise, store the left channel only as a mono sound." - - | samplesToStore channelCount dataByteCount samplesPerSec bytesPerSec | - samplesToStore := (self duration * self samplingRate) ceiling. - channelCount := self isStereo ifTrue: [2] ifFalse: [1]. - dataByteCount := samplesToStore * channelCount * 2. - samplesPerSec := self samplingRate rounded. - bytesPerSec := samplesPerSec * channelCount * 2. - - "file header" - aBinaryStream - nextPutAll: 'RIFF' asByteArray; - nextLittleEndianNumber: 4 put: dataByteCount + 36; "total length of all chunks" - nextPutAll: 'WAVE' asByteArray. - - "format chunk" - aBinaryStream - nextPutAll: 'fmt ' asByteArray; - nextLittleEndianNumber: 4 put: 16; "length of this chunk" - nextLittleEndianNumber: 2 put: 1; "format tag" - nextLittleEndianNumber: 2 put: channelCount; - nextLittleEndianNumber: 4 put: samplesPerSec; - nextLittleEndianNumber: 4 put: bytesPerSec; - nextLittleEndianNumber: 2 put: 4; "alignment" - nextLittleEndianNumber: 2 put: 16. "bits per sample" - - "data chunk" - aBinaryStream - nextPutAll: 'data' asByteArray; - nextLittleEndianNumber: 4 put: dataByteCount. "length of this chunk" - - self storeSampleCount: samplesToStore bigEndian: false on: aBinaryStream. - ! Item was removed: - ----- Method: AbstractSound>>updateVolume (in category 'sound generation') ----- - 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]]. - ! Item was removed: - ----- Method: AbstractSound>>volumeEnvelopeScaledTo: (in category 'volume') ----- - 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'. - ! Item was removed: - AbstractScoreEvent subclass: #AmbientEvent - instanceVariableNames: 'morph target selector arguments' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! Item was removed: - ----- Method: AmbientEvent>>morph (in category 'accessing') ----- - morph - ^ morph! Item was removed: - ----- Method: AmbientEvent>>morph: (in category 'accessing') ----- - morph: m - morph := m! Item was removed: - ----- Method: AmbientEvent>>occurAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'sound generation') ----- - occurAtTime: ticks inScorePlayer: player atIndex: index inEventTrack: track secsPerTick: secsPerTick - (target == nil or: [selector == nil]) ifTrue: - [morph ifNil: [^ self]. - ^ morph encounteredAtTime: ticks inScorePlayer: player atIndex: index - inEventTrack: track secsPerTick: secsPerTick]. - target perform: selector withArguments: arguments! Item was removed: - ----- Method: AmbientEvent>>target:selector:arguments: (in category 'accessing') ----- - target: t selector: s arguments: a - target := t. - selector := s. - arguments := a. - ! Item was removed: - AbstractSoundSystem subclass: #BaseSoundSystem - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !BaseSoundSystem commentStamp: 'gk 2/24/2004 08:35' prior: 0! - This is the normal sound system in Squeak and is registered in SoundService - an AppRegistry - so that a small highlevel protocol for playing sounds can be used in a pluggable fashion. - - More information available in superclass.! Item was removed: - ----- Method: BaseSoundSystem class>>initialize (in category 'class initialization') ----- - initialize - - SoundService register: self. - - SoundService defaultOrNil - ifNil: [SoundService default: self].! Item was removed: - ----- Method: BaseSoundSystem class>>unload (in category 'class initialization') ----- - unload - SoundService unregister: self! Item was removed: - ----- Method: BaseSoundSystem>>beep (in category 'playing') ----- - beep - "There is sound support, so we use the default - sampled sound for a beep." - - ^ SampledSound beep! Item was removed: - ----- Method: BaseSoundSystem>>playSampledSound:rate: (in category 'playing') ----- - playSampledSound: samples rate: rate - - ^ (SampledSound samples: samples samplingRate: rate) play! Item was removed: - ----- Method: BaseSoundSystem>>playSound: (in category 'playing') ----- - playSound: sound - - SoundPlayer playSound: sound. - ^ sound! Item was removed: - ----- Method: BaseSoundSystem>>playSoundNamed: (in category 'playing') ----- - playSoundNamed: soundName - "There is sound support, so we play the given sound." - - ^ SampledSound playSoundNamed: soundName asString! Item was removed: - ----- Method: BaseSoundSystem>>playSoundNamed:ifAbsentReadFrom: (in category 'playing') ----- - playSoundNamed: soundName ifAbsentReadFrom: aifFileName - - (SampledSound soundNames includes: soundName) ifFalse: [ - (FileDirectory default fileExists: aifFileName) ifTrue: [ - SampledSound - addLibrarySoundNamed: soundName - fromAIFFfileNamed: aifFileName]]. - - (SampledSound soundNames includes: soundName) ifTrue: [ - ^ SampledSound playSoundNamed: soundName]. - - ^ nil! Item was removed: - ----- Method: BaseSoundSystem>>playSoundNamedOrBeep: (in category 'playing') ----- - playSoundNamedOrBeep: soundName - "There is sound support, so we play the given sound - instead of beeping." - - ^ self playSoundNamed: soundName! Item was removed: - ----- Method: BaseSoundSystem>>randomBitsFromSoundInput: (in category 'misc') ----- - randomBitsFromSoundInput: bitCount - "Answer a positive integer with the given number of random bits of 'noise' from a sound input source. Typically, one would use a microphone or line input as the sound source, although many sound cards have enough thermal noise that you get random low-order sample bits even with no microphone connected. Only the least signficant bit of the samples is used. Since not all sound cards support 16-bits of sample resolution, we use the lowest bit that changes." - "(1 to: 10) collect: [:i | BaseSoundSystem new randomBitsFromSoundInput: 512]" - - | recorder buf mid samples bitMask randomBits bit | - "collect some sound data" - recorder := SoundRecorder new clearRecordedSound. - recorder resumeRecording. - (Delay forSeconds: 1) wait. - recorder stopRecording. - buf := recorder condensedSamples. - - "grab bitCount samples from the middle" - mid := buf monoSampleCount // 2. - samples := buf copyFrom: mid to: mid + bitCount - 1. - - "find the least significant bit that varies" - bitMask := 1. - [bitMask < 16r10000 and: - [(samples collect: [:s | s bitAnd: bitMask]) asSet size < 2]] - whileTrue: [bitMask := bitMask bitShift: 1]. - bitMask = 16r10000 ifTrue: [^ self error: 'sound samples do not vary']. - - "pack the random bits into a positive integer" - randomBits := 0. - 1 to: samples size do: [:i | - bit := ((samples at: i) bitAnd: bitMask) = 0 ifTrue: [0] ifFalse: [1]. - randomBits := (randomBits bitShift: 1) + bit]. - - ^ randomBits - ! Item was removed: - ----- Method: BaseSoundSystem>>sampledSoundChoices (in category 'misc') ----- - sampledSoundChoices - ^ SampledSound soundNames! Item was removed: - ----- Method: BaseSoundSystem>>shutDown (in category 'misc') ----- - shutDown - - SoundPlayer shutDown: true. - ScorePlayer shutDown: true.! Item was removed: - ----- Method: BaseSoundSystem>>soundNamed: (in category 'misc') ----- - soundNamed: soundName - ^ SampledSound soundNamed: soundName! Item was removed: - Object subclass: #CompressedSoundData - instanceVariableNames: 'channels soundClassName codecName loopEnd loopLength perceivedPitch samplingRate gain firstSample cachedSound' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !CompressedSoundData commentStamp: '<historical>' prior: 0! - Instances of this class hold the data resulting from compressing a sound. Each carries a reference to the codec class that created it, so that it can reconstruct a sound similar to the original in response to the message asSound. - - In order to facilitate integration with existing sounds, a CompressedSoundData instance can masquerade as a sound by caching a copy of its original sound and delegating the essential sound-playing protocol to that cached copy. It should probably be made a subclass of AbstractSound to complete the illusion.! Item was removed: - ----- Method: CompressedSoundData>>asSound (in category 'asSound') ----- - asSound - "Answer the result of decompressing the receiver." - - | codecClass | - codecClass := Smalltalk at: codecName - ifAbsent: [^ self error: 'The codec for decompressing this sound is not available']. - ^ (codecClass new decompressSound: self) reset - ! Item was removed: - ----- Method: CompressedSoundData>>channels (in category 'accessing') ----- - channels - "Answer an array of ByteArrays containing the compressed sound data for each channel." - - ^ channels - ! Item was removed: - ----- Method: CompressedSoundData>>channels: (in category 'accessing') ----- - channels: anArray - - channels := anArray. - ! Item was removed: - ----- Method: CompressedSoundData>>codecName (in category 'accessing') ----- - codecName - "Answer the name of the sound codec used to compress this sound. Typically, this is the name of a class that can be used to decode the sound, but it is possible that the codec has not yet been implemented or is not filed into this image." - - ^ codecName - ! Item was removed: - ----- Method: CompressedSoundData>>codecName: (in category 'accessing') ----- - codecName: aStringOrSymbol - - codecName := aStringOrSymbol asSymbol. - ! Item was removed: - ----- Method: CompressedSoundData>>compressWith: (in category 'compressing') ----- - compressWith: codecClass - - codecName == codecClass name asSymbol ifTrue: [^self]. - ^self asSound compressWith: codecClass! Item was removed: - ----- Method: CompressedSoundData>>compressWith:atRate: (in category 'compressing') ----- - compressWith: codecClass atRate: aSamplingRate - - (codecName == codecClass name asSymbol and: [samplingRate = aSamplingRate]) ifTrue: [^self]. - ^self asSound compressWith: codecClass atRate: aSamplingRate! Item was removed: - ----- Method: CompressedSoundData>>doControl (in category 'asSound') ----- - doControl - - cachedSound doControl - ! Item was removed: - ----- Method: CompressedSoundData>>firstSample (in category 'accessing') ----- - firstSample - "Answer the firstSample of the original sound." - - ^ firstSample - ! Item was removed: - ----- Method: CompressedSoundData>>firstSample: (in category 'accessing') ----- - firstSample: anInteger - - firstSample := anInteger. - ! Item was removed: - ----- Method: CompressedSoundData>>gain (in category 'accessing') ----- - gain - "Answer the gain of the original sound." - - ^ gain - ! Item was removed: - ----- Method: CompressedSoundData>>gain: (in category 'accessing') ----- - gain: aNumber - - gain := aNumber. - ! Item was removed: - ----- Method: CompressedSoundData>>loopEnd (in category 'accessing') ----- - loopEnd - "Answer index of the last sample of the loop, or nil if the original sound was not looped." - - ^ loopEnd - ! Item was removed: - ----- Method: CompressedSoundData>>loopEnd: (in category 'accessing') ----- - loopEnd: anInteger - - loopEnd := anInteger. - ! Item was removed: - ----- Method: CompressedSoundData>>loopLength (in category 'accessing') ----- - loopLength - "Answer length of the loop, or nil if the original sound was not looped." - - ^ loopLength - ! Item was removed: - ----- Method: CompressedSoundData>>loopLength: (in category 'accessing') ----- - loopLength: anInteger - - loopLength := anInteger. - ! Item was removed: - ----- Method: CompressedSoundData>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'asSound') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - - cachedSound mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - ! Item was removed: - ----- Method: CompressedSoundData>>perceivedPitch (in category 'accessing') ----- - perceivedPitch - "Answer the perceived pitch of the original sound. By convention, unpitched sounds (like drum hits) are given an arbitrary pitch of 100.0." - - ^ perceivedPitch - ! Item was removed: - ----- Method: CompressedSoundData>>perceivedPitch: (in category 'accessing') ----- - perceivedPitch: aNumber - - perceivedPitch := aNumber. - ! Item was removed: - ----- Method: CompressedSoundData>>reset (in category 'asSound') ----- - reset - "This message is the cue to start behaving like a real sound in order to be played. - We do this by caching a decompressed version of this sound. - See also samplesRemaining." - - cachedSound == nil ifTrue: [cachedSound := self asSound]. - cachedSound reset - ! Item was removed: - ----- Method: CompressedSoundData>>samples (in category 'asSound') ----- - samples - - ^ self asSound samples! Item was removed: - ----- Method: CompressedSoundData>>samplesRemaining (in category 'asSound') ----- - samplesRemaining - "This message is the cue that the cached sound may no longer be needed. - We know it is done playing when samplesRemaining=0." - - | samplesRemaining | - samplesRemaining := cachedSound samplesRemaining. - samplesRemaining <= 0 ifTrue: [cachedSound := nil]. - ^ samplesRemaining! Item was removed: - ----- Method: CompressedSoundData>>samplingRate (in category 'accessing') ----- - samplingRate - "Answer the samplingRate of the original sound." - - ^ samplingRate - ! Item was removed: - ----- Method: CompressedSoundData>>samplingRate: (in category 'accessing') ----- - samplingRate: aNumber - - samplingRate := aNumber. - ! Item was removed: - ----- Method: CompressedSoundData>>soundClassName (in category 'accessing') ----- - soundClassName - "Answer the class name of the uncompressed sound." - - ^ soundClassName - ! Item was removed: - ----- Method: CompressedSoundData>>soundClassName: (in category 'accessing') ----- - soundClassName: aStringOrSymbol - - soundClassName := aStringOrSymbol asSymbol. - ! Item was removed: - ----- Method: CompressedSoundData>>withEToySound:samplingRate: (in category 'initialize-release') ----- - withEToySound: aByteArray samplingRate: anInteger - - soundClassName := #SampledSound. - channels := {aByteArray}. - codecName := #GSMCodec. - loopEnd := nil. "???" - loopLength := nil. - perceivedPitch := 100.0. - samplingRate := anInteger. - gain := 1.0. "???" - firstSample := 1. - cachedSound := nil. "???"! Item was removed: - AbstractScoreEvent subclass: #ControlChangeEvent - instanceVariableNames: 'control value channel' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! Item was removed: - ----- Method: ControlChangeEvent>>channel (in category 'accessing') ----- - channel - - ^ channel - ! Item was removed: - ----- Method: ControlChangeEvent>>channel: (in category 'accessing') ----- - channel: midiChannel - - channel := midiChannel. - ! Item was removed: - ----- Method: ControlChangeEvent>>control (in category 'accessing') ----- - control - - ^ control - ! Item was removed: - ----- Method: ControlChangeEvent>>control: (in category 'accessing') ----- - control: midiControl - - control := midiControl. - ! Item was removed: - ----- Method: ControlChangeEvent>>control:value:channel: (in category 'accessing') ----- - control: midiControl value: midiControlValue channel: midiChannel - - control := midiControl. - value := midiControlValue. - channel := midiChannel. - ! Item was removed: - ----- Method: ControlChangeEvent>>isControlChange (in category 'classification') ----- - isControlChange - - ^ true - ! Item was removed: - ----- Method: ControlChangeEvent>>outputOnMidiPort: (in category 'midi') ----- - outputOnMidiPort: aMidiPort - "Output this event to the given MIDI port." - - aMidiPort - midiCmd: 16rB0 - channel: channel - byte: control - byte: value. - ! Item was removed: - ----- Method: ControlChangeEvent>>printOn: (in category 'printing') ----- - printOn: aStream - aStream - nextPut: $(; - print: time; - nextPutAll: ': ctrl['; - print: control; - nextPutAll: ']='; - print: value; - nextPut: $)! Item was removed: - ----- Method: ControlChangeEvent>>value (in category 'accessing') ----- - value - - ^ value - ! Item was removed: - ----- Method: ControlChangeEvent>>value: (in category 'accessing') ----- - value: midiControlValue - - value := midiControlValue. - ! Item was removed: - Object subclass: #Envelope - instanceVariableNames: 'points loopStartIndex loopEndIndex loopStartMSecs loopMSecs target updateSelector loopEndMSecs endMSecs scale decayScale lastValue currValue valueIncr nextRecomputeTime noChangesDuringLoop' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !Envelope commentStamp: '<historical>' prior: 0! - An envelope models a three-stage progression for a musical note: attack, sustain, decay. Envelopes can either return the envelope value at a given time or can update some target object using a client-specified message selector. - - The points instance variable holds an array of (time, value) points, where the times are in milliseconds. The points array must contain at least two points. The time coordinate of the first point must be zero and the time coordinates of subsequent points must be in ascending order, although the spacing between them is arbitrary. Envelope values between points are computed by linear interpolation. - - The scale slot is initially set so that the peak of envelope matches some note attribute, such as its loudness. When entering the decay phase, the scale is adjusted so that the decay begins from the envelope's current value. This avoids a potential sharp transient when entering the decay phase. - - The loopStartIndex and loopEndIndex slots contain the indices of points in the points array; if they are equal, then the envelope holds a constant value for the sustain phase of the note. Otherwise, envelope values are computed by repeatedly looping between these two points. - - The loopEndMSecs slot can be set in advance (as when playing a score) or dynamically (as when responding to interactive inputs from a MIDI keyboard). In the latter case, the value of scale is adjusted to start the decay phase with the current envelope value. Thus, if a note ends before its attack is complete, the decay phase is started immediately (i.e., the attack phase is never completed). - - For best results, amplitude envelopes should start and end with zero values. Otherwise, the sharp transient at the beginning or end of the note may cause audible clicks or static. For envelopes on other parameters, this may not be necessary. - ! Item was removed: - ----- Method: Envelope class>>example (in category 'instance creation') ----- - example - "Envelope example" - - | p | - p := Array with: 0 at 0 with: 100 at 1.0 with: 250 at 0.7 with: 400 at 1.0 with: 500 at 0. - ^ (self points: p loopStart: 2 loopEnd: 4) sustainEnd: 1200. - ! Item was removed: - ----- Method: Envelope class>>exponentialDecay: (in category 'instance creation') ----- - exponentialDecay: multiplier - "(Envelope exponentialDecay: 0.95) " - - | mSecsPerStep pList t v last | - mSecsPerStep := 10. - ((multiplier > 0.0) and: [multiplier < 1.0]) - ifFalse: [self error: 'multiplier must be greater than 0.0 and less than 1.0']. - pList := OrderedCollection new. - pList add: 0 at 0.0. - last := 0.0. - v := 1.0. - t := 10. - [v > 0.01] whileTrue: [ - (v - last) abs > 0.02 ifTrue: [ - "only record substatial changes" - pList add: t at v. - last := v]. - t := t + mSecsPerStep. - v := v * multiplier]. - pList add: (t + mSecsPerStep)@0.0. - - ^ self points: pList asArray - loopStart: pList size - loopEnd: pList size - ! Item was removed: - ----- Method: Envelope class>>points:loopStart:loopEnd: (in category 'instance creation') ----- - points: pList loopStart: loopStart loopEnd: loopEnd - - ^ self new setPoints: pList asArray - loopStart: loopStart - loopEnd: loopEnd - ! Item was removed: - ----- Method: Envelope>>attackTime (in category 'accessing') ----- - attackTime - "Return the time taken by the attack phase." - - ^ (points at: loopStartIndex) x - ! Item was removed: - ----- Method: Envelope>>centerPitch: (in category 'accessing') ----- - centerPitch: aNumber - "Set the center pitch of a pitch-controlling envelope. This default implementation does nothing." - ! Item was removed: - ----- Method: Envelope>>checkParameters (in category 'private') ----- - checkParameters - "Verify that the point array, loopStartIndex, and loopStopIndex obey the rules." - - | lastT t | - points size > 1 - ifFalse: [^ self error: 'the point list must contain at least two points']. - points first x = 0 - ifFalse: [^ self error: 'the time of the first point must be zero']. - lastT := points first x. - 2 to: points size do: [:i | - t := (points at: i) x. - t >= lastT - ifFalse: [^ self error: 'the points must be in ascending time order']]. - - (loopStartIndex isInteger and: - [(loopStartIndex > 0) and: [loopStartIndex <= points size]]) - ifFalse: [^ self error: 'loopStartIndex is not a valid point index']. - (loopEndIndex isInteger and: - [(loopEndIndex > 0) and: [loopEndIndex <= points size]]) - ifFalse: [^ self error: 'loopEndIndex is not a valid point index']. - loopStartIndex <= loopEndIndex - ifFalse: [^ self error: 'loopEndIndex must not precede loopStartIndex']. - ! Item was removed: - ----- Method: Envelope>>computeIncrementAt:between:and:scale: (in category 'private') ----- - computeIncrementAt: mSecs between: p1 and: p2 scale: combinedScale - "Compute the current and increment values for the given time between the given inflection points." - "Assume: p1 x <= mSecs <= p2 x" - - | valueRange timeRange | - valueRange := (p2 y - p1 y) asFloat. - timeRange := (p2 x - p1 x) asFloat. - currValue := (p1 y + (((mSecs - p1 x) asFloat / timeRange) * valueRange)) * combinedScale. - valueIncr := (((p2 y * combinedScale) - currValue) / (p2 x - mSecs)) * 10.0. - ^ currValue - ! Item was removed: - ----- Method: Envelope>>computeSustainValueAtMSecs: (in category 'applying') ----- - computeSustainValueAtMSecs: mSecs - "Return the value of this envelope at the given number of milliseconds from its onset. Return zero for times outside the time range of this envelope." - "Note: Unlike the private method incrementalComputeValueAtMSecs:, this method does is not increment. Thus it is slower, but it doesn't depend on being called sequentially at fixed time intervals. - Note: this is the same as computeValueAtMSecs: apart from removing the first section that requires loopEndMSecs t obe nil; this appears to cause a problem when a sound in playing and is stopped whilst the #computeSlopeAtMSecs: method is run inside the SoundPlayer loop" - - | t i | - mSecs < 0 ifTrue: [^ 0.0]. - - mSecs < loopStartMSecs ifTrue: [ "attack phase" - i := self indexOfPointAfterMSecs: mSecs startingAt: 1. - i = 1 ifTrue: [^ (points at: 1) y * scale]. - ^ self interpolate: mSecs between: (points at: i - 1) and: (points at: i)]. - - "sustain phase" - loopMSecs = 0 ifTrue: [^ (points at: loopEndIndex) y * scale]. "looping on a single point" - t := loopStartMSecs + ((mSecs - loopStartMSecs) \\ loopMSecs). - i := self indexOfPointAfterMSecs: t startingAt: loopStartIndex. - - ^ self interpolate: t between: (points at: i - 1) and: (points at: i) - ! Item was removed: - ----- Method: Envelope>>decayEndIndex (in category 'accessing') ----- - decayEndIndex - - ^ points size - ! Item was removed: - ----- Method: Envelope>>decayTime (in category 'accessing') ----- - decayTime - "Return the time taken by the decay phase." - - ^ points last x - (points at: loopEndIndex) x - ! Item was removed: - ----- Method: Envelope>>duration (in category 'accessing') ----- - duration - "Return the time of the final point." - - loopEndMSecs == nil - ifTrue: [^ points last x] - ifFalse: [^ loopEndMSecs + self decayTime]. - ! Item was removed: - ----- Method: Envelope>>duration: (in category 'accessing') ----- - duration: seconds - "Set the note duration to the given number of seconds." - "Details: The duration is reduced by 19 mSec to ensure proper cutoffs even when the sound starts playing between doControl epochs." - "Note: This is a hack. With a little additional work on the envelope logic, it should be possible to reduce or eliminate this fudge factor. In particular, an envelope should use the time remaining, rather than time-since-start to determine when to enter its decay phase. In addition, an envelope must be able to cut off in minimum time (~5-10 msec) if there isn't enough time to do their normal decay. All of this is to allow instruments with leisurely decays to play very short notes if necessary (say, when fast-forwarding through a score)." - - | attack decay endTime | - endMSecs := (seconds * 1000.0) asInteger - 19. - attack := self attackTime. - decay := self decayTime. - endMSecs > (attack + decay) - ifTrue: [endTime := endMSecs - decay] - ifFalse: [ - endMSecs >= attack - ifTrue: [endTime := attack] - ifFalse: [endTime := endMSecs]]. - - self sustainEnd: (endTime max: 0). - ! Item was removed: - ----- Method: Envelope>>incrementalComputeValueAtMSecs: (in category 'private') ----- - incrementalComputeValueAtMSecs: mSecs - "Compute the current value, per-step increment, and the time of the next inflection point." - "Note: This method is part of faster, but less general, way of computing envelope values. It depends on a known, fixed control updating rate." - - | t i | - ((loopEndMSecs ~~ nil) and: [mSecs >= loopEndMSecs]) ifTrue: [ "decay phase" - t := (points at: loopEndIndex) x + (mSecs - loopEndMSecs). - i := self indexOfPointAfterMSecs: t startingAt: loopEndIndex. - i == nil ifTrue: [ "past end" - currValue := points last y * scale * decayScale. - valueIncr := 0.0. - nextRecomputeTime := mSecs + 1000000. - ^ currValue]. - nextRecomputeTime := mSecs + ((points at: i) x - t). - ^ self computeIncrementAt: t - between: (points at: i - 1) - and: (points at: i) - scale: scale * decayScale]. - - mSecs < loopStartMSecs - ifTrue: [ "attack phase" - t := mSecs. - i := self indexOfPointAfterMSecs: t startingAt: 1. - nextRecomputeTime := mSecs + ((points at: i) x - t)] - ifFalse: [ "sustain (looping) phase" - noChangesDuringLoop ifTrue: [ - currValue := (points at: loopEndIndex) y * scale. - valueIncr := 0.0. - loopEndMSecs == nil - ifTrue: [nextRecomputeTime := mSecs + 10] "unknown end time" - ifFalse: [nextRecomputeTime := loopEndMSecs]. - ^ currValue]. - t := loopStartMSecs + ((mSecs - loopStartMSecs) \\ loopMSecs). - i := self indexOfPointAfterMSecs: t startingAt: loopStartIndex. - nextRecomputeTime := (mSecs + ((points at: i) x - t)) min: loopEndMSecs]. - - ^ self computeIncrementAt: t - between: (points at: i - 1) - and: (points at: i) - scale: scale. - ! Item was removed: - ----- Method: Envelope>>indexOfPointAfterMSecs:startingAt: (in category 'private') ----- - indexOfPointAfterMSecs: mSecs startingAt: startIndex - "Return the index of the first point whose time is greater that mSecs, starting with the given index. Return nil if mSecs is after the last point's time." - - startIndex to: points size do: - [:i | (points at: i) x > mSecs ifTrue: [^ i]]. - ^ nil - ! Item was removed: - ----- Method: Envelope>>interpolate:between:and: (in category 'private') ----- - interpolate: mSecs between: p1 and: p2 - "Return the scaled, interpolated value for the given time between the given time points." - "Assume: p1 x <= mSecs <= p2 x" - - | valueRange timeRange | - valueRange := (p2 y - p1 y) asFloat. - valueRange = 0.0 ifTrue: [^ p1 y * scale]. - timeRange := (p2 x - p1 x) asFloat. - ^ (p1 y + (((mSecs - p1 x) asFloat / timeRange) * valueRange)) * scale. - ! Item was removed: - ----- Method: Envelope>>loopEndIndex (in category 'accessing') ----- - loopEndIndex - - ^ loopEndIndex - ! Item was removed: - ----- Method: Envelope>>loopStartIndex (in category 'accessing') ----- - loopStartIndex - - ^ loopStartIndex - ! Item was removed: - ----- Method: Envelope>>name (in category 'accessing') ----- - name - - ^ self updateSelector allButLast - ! Item was removed: - ----- Method: Envelope>>points (in category 'accessing') ----- - points - - ^ points - ! Item was removed: - ----- Method: Envelope>>reset (in category 'applying') ----- - reset - "Reset the state for this envelope." - - lastValue := -100000.0. "impossible value" - nextRecomputeTime := 0. - self updateTargetAt: 0. - ! Item was removed: - ----- Method: Envelope>>scale (in category 'accessing') ----- - scale - - ^ scale - ! Item was removed: - ----- Method: Envelope>>scale: (in category 'accessing') ----- - scale: aNumber - - scale := aNumber asFloat. - ! Item was removed: - ----- Method: Envelope>>setPoints:loopStart:loopEnd: (in category 'private') ----- - setPoints: pointList loopStart: startIndex loopEnd: endIndex - - | lastVal | - points := pointList asArray collect: [:p | p x asInteger @ p y asFloat]. - loopStartIndex := startIndex. - loopEndIndex := endIndex. - self checkParameters. - loopStartMSecs := (points at: loopStartIndex) x. - loopMSecs := (points at: loopEndIndex) x - (points at: loopStartIndex) x. - loopEndMSecs := nil. "unknown end time; sustain until end time is known" - scale ifNil: [scale := 1.0]. - decayScale ifNil: [decayScale := 1.0]. - - "note if there are no changes during the loop phase" - noChangesDuringLoop := true. - lastVal := (points at: loopStartIndex) y. - loopStartIndex to: loopEndIndex do: [:i | - (points at: i) y ~= lastVal ifTrue: [ - noChangesDuringLoop := false. - ^ self]]. - ! Item was removed: - ----- Method: Envelope>>storeOn: (in category 'storing') ----- - storeOn: strm - strm nextPutAll: '((' , self class name; - nextPutAll: ' points: '; store: (points collect: [:p | p x @ (p y roundTo: 0.00001)]); - nextPutAll: ' loopStart: '; print: loopStartIndex; - nextPutAll: ' loopEnd: '; print: loopEndIndex; nextPutAll: ')'; - nextPutAll: ' updateSelector: '; store: self updateSelector; nextPutAll: ';'; - nextPutAll: ' scale: '; print: scale; nextPutAll: ')'. - ! Item was removed: - ----- Method: Envelope>>sustainEnd: (in category 'applying') ----- - sustainEnd: mSecs - "Set the ending time of the sustain phase of this envelope; the decay phase will start this - point. Typically derived from a note's duration. - Details: to avoid a sharp transient, the decay phase is scaled so that the beginning of the - decay matches the envelope's instantaneous value when the decay phase starts." - - | vIfSustaining firstVOfDecay | - loopEndMSecs := mSecs. "no longer set to nil in order to pretend to be sustaining" - decayScale := 1.0. - nextRecomputeTime := 0. - vIfSustaining := self computeSustainValueAtMSecs: mSecs. "get value at end of sustain phase" - "loopEndMSecs := mSecs. not required any more" - firstVOfDecay := (points at: loopEndIndex) y * scale. - firstVOfDecay = 0.0 - ifTrue: [decayScale := 1.0] - ifFalse: [decayScale := vIfSustaining / firstVOfDecay]. - ! Item was removed: - ----- Method: Envelope>>target (in category 'accessing') ----- - target - - ^ target - ! Item was removed: - ----- Method: Envelope>>target: (in category 'accessing') ----- - target: anObject - - target := anObject. - ! Item was removed: - ----- Method: Envelope>>updateSelector (in category 'accessing') ----- - updateSelector - - ^ updateSelector - ! Item was removed: - ----- Method: Envelope>>updateSelector: (in category 'accessing') ----- - updateSelector: aSymbol - - updateSelector := aSymbol. - ! Item was removed: - ----- Method: Envelope>>updateTargetAt: (in category 'applying') ----- - updateTargetAt: mSecs - "Send my updateSelector to the given target object with the value of this envelope at the given number of milliseconds from its onset. Answer true if the value changed." - - | newValue | - newValue := self valueAtMSecs: mSecs. - newValue = lastValue ifTrue: [^ false]. - target - perform: updateSelector - with: newValue. - lastValue := newValue. - ^ true - ! Item was removed: - ----- Method: Envelope>>valueAtMSecs: (in category 'applying') ----- - valueAtMSecs: mSecs - "Return the value of this envelope at the given number of milliseconds from its onset. Return zero for times outside the time range of this envelope." - - mSecs < 0 ifTrue: [^ 0.0]. - mSecs < nextRecomputeTime - ifTrue: [currValue := currValue + valueIncr] - ifFalse: [currValue := self incrementalComputeValueAtMSecs: mSecs]. - ^ currValue - ! Item was removed: - ----- Method: Envelope>>volume: (in category 'accessing') ----- - volume: aNumber - "Set the maximum volume of a volume-controlling envelope. This default implementation does nothing." - ! Item was removed: - Object subclass: #FFT - instanceVariableNames: 'nu n sinTable permTable realData imagData window' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !FFT commentStamp: '<historical>' prior: 0! - This class implements the Fast Fourier Transform roughly as described on page 367 - of "Theory and Application of Digital Signal Processing" by Rabiner and Gold. - Each instance caches tables used for transforming a given size (n = 2^nu samples) of data. - - It would have been cleaner using complex numbers, but often the data is all real.! Item was removed: - ----- Method: FFT class>>new: (in category 'instance creation') ----- - new: anIntegerPowerOfTwo - "Answer a new FFT instance for transforming data packets of the given size." - - ^ self new setSize: anIntegerPowerOfTwo - ! Item was removed: - ----- Method: FFT>>imagData (in category 'testing') ----- - imagData - - ^ imagData - ! Item was removed: - ----- Method: FFT>>initializeHammingWindow: (in category 'bulk processing') ----- - initializeHammingWindow: alpha - "Initialize the windowing function to the generalized Hamming window. See F. Richard Moore, Elements of Computer Music, p. 100. An alpha of 0.54 gives the Hamming window, 0.5 gives the hanning window." - - | v midPoint | - window := Float32Array new: n. - midPoint := (n + 1) / 2.0. - 1 to: n do: [:i | - v := alpha + ((1.0 - alpha) * (2.0 * Float pi * ((i - midPoint) / n)) cos). - window at: i put: v]. - - ! Item was removed: - ----- Method: FFT>>initializeTriangularWindow (in category 'bulk processing') ----- - initializeTriangularWindow - "Initialize the windowing function to the triangular, or Parzen, window. See F. Richard Moore, Elements of Computer Music, p. 100." - - | v | - window := Float32Array new: n. - 0 to: (n // 2) - 1 do: [:i | - v := i / ((n // 2) - 1). - window at: (i + 1) put: v. - window at: (n - i) put: v]. - ! Item was removed: - ----- Method: FFT>>n (in category 'initialization') ----- - n - - ^ n - ! Item was removed: - ----- Method: FFT>>nu: (in category 'initialization') ----- - nu: order - "Initialize variables and tables for transforming 2^nu points" - | j perms k | - nu := order. - n := 2 bitShift: nu-1. - - "Initialize permutation table (bit-reversed indices)" - j:=0. - perms := WriteStream on: (Array new: n). - 0 to: n-2 do: - [:i | - i < j ifTrue: [perms nextPut: i+1; nextPut: j+1]. - k := n // 2. - [k <= j] whileTrue: [j := j-k. k := k//2]. - j := j + k]. - permTable := perms contents. - - "Initialize sin table 0..pi/2 in n/4 steps." - sinTable := (0 to: n/4) collect: [:i | (i asFloat / (n//4) * Float pi / 2.0) sin]! Item was removed: - ----- Method: FFT>>permuteData (in category 'transforming') ----- - permuteData - | i end a b | - i := 1. - end := permTable size. - [i <= end] whileTrue: - [a := permTable at: i. - b := permTable at: i+1. - realData swap: a with: b. - imagData swap: a with: b. - i := i + 2]! Item was removed: - ----- Method: FFT>>plot:in: (in category 'testing') ----- - plot: samples in: rect - "Throw-away code just to check out a couple of examples" - | dx pen min max x divisor offset | - Display fillWhite: rect; border: (rect expandBy: 2) width: 2. - min := 1.0e30. max := -1.0e30. - samples do: - [:v | - min := min min: v. - max := max max: v]. - max = min - ifTrue: [divisor := rect height asFloat. - offset := rect height / 2.0] - ifFalse: [divisor := max - min. - offset := 0.0]. - pen := Pen new. pen up. - x := rect left. - dx := rect width asFloat / samples size. - samples do: - [:v | | y | - y := (max - v) / divisor * rect height + offset. - pen goto: x asInteger @ (rect top + y asInteger); down. - x := x + dx]. - max printString displayOn: Display at: (x + 2) @ (rect top - 9). - min printString displayOn: Display at: (x + 2) @ (rect bottom - 9)! Item was removed: - ----- Method: FFT>>pluginPrepareData (in category 'plugin-testing') ----- - pluginPrepareData - "The FFT plugin requires data to be represented in WordArrays or FloatArrays" - sinTable := sinTable asFloat32Array. - permTable := permTable asWordArray. - realData := realData asFloat32Array. - imagData := imagData asFloat32Array.! Item was removed: - ----- Method: FFT>>pluginTest (in category 'plugin-testing') ----- - pluginTest "Display restoreAfter: [(FFT new nu: 12) pluginTest]." - "Test on an array of 256 samples" - "Initialize to pure (co)Sine Wave, plot, transform, plot, invert and plot again" - self realData: ((1 to: n) collect: [:i | (Float pi * (i-1) / (n/8)) cos]). - self plot: realData in: (100 at 20 extent: 256 at 60). - self pluginPrepareData. - Transcript cr; print: (Time millisecondsToRun:[self pluginTransformData: true]); endEntry. - self plot: realData in: (100 at 100 extent: 256 at 60). - self plot: imagData in: (100 at 180 extent: 256 at 60). - Transcript cr; print: (Time millisecondsToRun:[self pluginTransformData: false]); endEntry. - self plot: realData in: (100 at 260 extent: 256 at 60)! Item was removed: - ----- Method: FFT>>pluginTransformData: (in category 'plugin-testing') ----- - pluginTransformData: forward - "Plugin testing -- if the primitive is not implemented - or cannot be found run the simulation. See also: FFTPlugin" - <primitive: 'primitiveFFTTransformData' module: 'FFTPlugin'> - ^(Smalltalk at: #FFTPlugin ifAbsent:[^self primitiveFailed]) - doPrimitive: 'primitiveFFTTransformData'.! Item was removed: - ----- Method: FFT>>realData (in category 'testing') ----- - realData - - ^ realData - ! Item was removed: - ----- Method: FFT>>realData: (in category 'initialization') ----- - realData: real - realData := real. - imagData := real collect: [:i | 0.0] "imaginary component all zero"! Item was removed: - ----- Method: FFT>>realData:imagData: (in category 'initialization') ----- - realData: real imagData: imag - realData := real. - imagData := imag! Item was removed: - ----- Method: FFT>>samplesPerCycleForIndex: (in category 'testing') ----- - samplesPerCycleForIndex: i - "Answer the number of samples per cycle corresponding to a power peak at the given index. Answer zero if i = 1, since an index of 1 corresponds to the D.C. component." - - | windowSize | - windowSize := 2 raisedTo: nu. - (i < 1 or: [i > (windowSize // 2)]) ifTrue: [^ self error: 'index is out of range']. - i = 1 ifTrue: [^ 0]. "the D.C. component" - ^ windowSize asFloat / (i - 1) - ! Item was removed: - ----- Method: FFT>>scaleData (in category 'transforming') ----- - scaleData - "Scale all elements by 1/n when doing inverse" - | realN | - realN := n asFloat. - 1 to: n do: - [:i | - realData at: i put: (realData at: i) / realN. - imagData at: i put: (imagData at: i) / realN]! Item was removed: - ----- Method: FFT>>setSize: (in category 'bulk processing') ----- - setSize: anIntegerPowerOfTwo - "Initialize variables and tables for performing an FFT on the given number of samples. The number of samples must be an integral power of two (e.g. 1024). Prepare data for use with the fast primitive." - - self nu: (anIntegerPowerOfTwo log: 2) asInteger. - n = anIntegerPowerOfTwo ifFalse: [self error: 'size must be a power of two']. - sinTable := sinTable asFloat32Array. - permTable := permTable asWordArray. - realData := Float32Array new: n. - imagData := Float32Array new: n. - self initializeHammingWindow: 0.54. "0.54 for Hamming, 0.5 for hanning" - ! Item was removed: - ----- Method: FFT>>test (in category 'testing') ----- - test "Display restoreAfter: [(FFT new nu: 8) test]. -- Test on an array of 256 samples" - "Initialize to pure (co)Sine Wave, plot, transform, plot, invert and plot again" - self realData: ((1 to: n) collect: [:i | (Float pi * (i-1) / (n/8)) cos]). - self plot: realData in: (100 at 20 extent: 256 at 60). - self transformForward: true. - self plot: realData in: (100 at 100 extent: 256 at 60). - self plot: imagData in: (100 at 180 extent: 256 at 60). - self transformForward: false. - self plot: realData in: (100 at 260 extent: 256 at 60)! Item was removed: - ----- Method: FFT>>transformDataFrom:startingAt: (in category 'bulk processing') ----- - transformDataFrom: anIndexableCollection startingAt: index - "Forward transform a block of real data taken from from the given indexable collection starting at the given index. Answer a block of values representing the normalized magnitudes of the frequency components." - - | j real imag out | - j := 0. - index to: index + n - 1 do: [:i | - realData at: (j := j + 1) put: (anIndexableCollection at: i)]. - realData *= window. - imagData := Float32Array new: n. - self transformForward: true. - - "compute the magnitudes of the complex results" - "note: the results are in bottom half; the upper half is just its mirror image" - real := realData copyFrom: 1 to: (n / 2). - imag := imagData copyFrom: 1 to: (n / 2). - out := (real * real) + (imag * imag). - 1 to: out size do: [:i | out at: i put: (out at: i) sqrt]. - ^ out - ! Item was removed: - ----- Method: FFT>>transformForward: (in category 'transforming') ----- - transformForward: forward - | lev lev1 ip theta realU imagU realT imagT i | - <primitive: 'primitiveFFTTransformData' module: 'FFTPlugin'> - self permuteData. - 1 to: nu do: - [:level | - lev := 1 bitShift: level. - lev1 := lev // 2. - 1 to: lev1 do: - [:j | - theta := j-1 * (n // lev). "pi * (j-1) / lev1 mapped onto 0..n/2" - theta < (n//4) "Compute U, the complex multiplier for each level" - ifTrue: - [realU := sinTable at: sinTable size - theta. - imagU := sinTable at: theta + 1] - ifFalse: - [realU := (sinTable at: theta - (n//4) + 1) negated. - imagU := sinTable at: (n//2) - theta + 1]. - forward ifFalse: [imagU := imagU negated]. - " - Here is the inner loop... - j to: n by: lev do: - [:i | hand-transformed to whileTrue... - " - i := j. - [i <= n] whileTrue: - [ip := i + lev1. - realT := ((realData at: ip) * realU) - ((imagData at: ip) * imagU). - imagT := ((realData at: ip) * imagU) + ((imagData at: ip) * realU). - realData at: ip put: (realData at: i) - realT. - imagData at: ip put: (imagData at: i) - imagT. - realData at: i put: (realData at: i) + realT. - imagData at: i put: (imagData at: i) + imagT. - i := i + lev]]]. - forward ifFalse: [self scaleData] "Reverse transform must scale to be an inverse"! Item was removed: - FMSound subclass: #FMBassoonSound - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: FMBassoonSound>>setPitch:dur:loudness: (in category 'initialization') ----- - setPitch: pitchNameOrNumber dur: d loudness: l - "Select a modulation ratio and modulation envelope scale based on my pitch." - - | p modScale | - p := self nameOrNumberToPitch: pitchNameOrNumber. - modScale := 9.4. - p > 100.0 ifTrue: [modScale := 8.3]. - p > 150.0 ifTrue: [modScale := 6.4]. - p > 200.0 ifTrue: [modScale := 5.2]. - p > 300.0 ifTrue: [modScale := 3.9]. - p > 400.0 ifTrue: [modScale := 2.8]. - p > 600.0 ifTrue: [modScale := 1.7]. - - envelopes size > 0 ifTrue: [ - envelopes do: [:e | - (e updateSelector = #modulation:) - ifTrue: [e scale: modScale]]]. - - super setPitch: p dur: d loudness: l. - ! Item was removed: - FMSound subclass: #FMClarinetSound - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: FMClarinetSound>>setPitch:dur:loudness: (in category 'initialization') ----- - setPitch: pitchNameOrNumber dur: d loudness: l - "Select a modulation ratio and modulation envelope scale based on my pitch." - - | p modScale | - p := self nameOrNumberToPitch: pitchNameOrNumber. - p < 262.0 - ifTrue: [modScale := 25.0. self ratio: 4] - ifFalse: [modScale := 20.0. self ratio: 2]. - p > 524.0 ifTrue: [modScale := 8.0]. - - envelopes size > 0 ifTrue: [ - envelopes do: [:e | - (e updateSelector = #modulation:) - ifTrue: [e scale: modScale]]]. - - super setPitch: p dur: d loudness: l. - ! Item was removed: - AbstractSound subclass: #FMSound - instanceVariableNames: 'initialCount count waveTable scaledWaveTableSize scaledIndex scaledIndexIncr modulation multiplier normalizedModulation scaledOffsetIndex scaledOffsetIndexIncr' - classVariableNames: 'SineTable' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: FMSound class>>bass1 (in category 'instruments') ----- - bass1 - "FMSound bass1 play" - "(FMSound lowMajorScaleOn: FMSound bass1) play" - - | snd | - snd := FMSound new modulation: 0 ratio: 0. - snd addEnvelope: (VolumeEnvelope exponentialDecay: 0.95). - ^ snd setPitch: 220 dur: 1.0 loudness: 0.3 - ! Item was removed: - ----- Method: FMSound class>>bassoon1 (in category 'instruments') ----- - bassoon1 - "FMSound bassoon1 play" - "(FMSound lowMajorScaleOn: FMSound bassoon1) play" - - | snd p env | - snd := FMBassoonSound new ratio: 1. - - p := OrderedCollection new. - p add: 0 at 0.0; add: 40 at 0.45; add: 90 at 1.0; add: 180 at 0.9; add: 270 at 1.0; add: 320 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 3 loopEnd: 5). - - p := OrderedCollection new. - p add: 0 at 0.2; add: 40 at 0.9; add: 90 at 0.6; add: 270 at 0.6; add: 320 at 0.5. - env := Envelope points: p loopStart: 3 loopEnd: 4. - env updateSelector: #modulation:; scale: 5.05. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>brass1 (in category 'instruments') ----- - brass1 - "FMSound brass1 play" - "(FMSound lowMajorScaleOn: FMSound brass1) play" - - | snd p env | - snd := FMSound new modulation: 0 ratio: 1. - p := OrderedCollection new. - p add: 0 at 0.0; add: 30 at 0.8; add: 90 at 1.0; add: 120 at 0.9; add: 220 at 0.7; add: 320 at 0.9; add: 360 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 4 loopEnd: 6). - - p := OrderedCollection new. - p add: 0 at 0.5; add: 60 at 1.0; add: 120 at 0.8; add: 220 at 0.65; add: 320 at 0.8; add: 360 at 0.0. - env := Envelope points: p loopStart: 3 loopEnd: 5. - env target: snd; updateSelector: #modulation:; scale: 5.0. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>brass2 (in category 'instruments') ----- - brass2 - "FMSound brass2 play" - "(FMSound lowMajorScaleOn: FMSound brass2) play" - - | snd p env | - snd := FMSound new modulation: 1 ratio: 1. - - p := OrderedCollection new. - p add: 0 at 0.0; add: 20 at 1.0; add: 40 at 0.9; add: 100 at 0.7; add: 160 at 0.9; add: 200 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 3 loopEnd: 5). - - p := OrderedCollection new. - p add: 0 at 0.5; add: 30 at 1.0; add: 40 at 0.8; add: 100 at 0.7; add: 160 at 0.8; add: 200 at 0.0. - env := Envelope points: p loopStart: 3 loopEnd: 5. - env updateSelector: #modulation:; scale: 5.0. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>clarinet (in category 'instruments') ----- - clarinet - "FMSound clarinet play" - "(FMSound lowMajorScaleOn: FMSound clarinet) play" - - | snd p env | - snd := FMSound new modulation: 0 ratio: 2. - - p := OrderedCollection new. - p add: 0 at 0.0; add: 60 at 1.0; add: 310 at 1.0; add: 350 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). - - p := OrderedCollection new. - p add: 0 at 0.0167; add: 60 at 0.106; add: 310 at 0.106; add: 350 at 0.0. - env := Envelope points: p loopStart: 2 loopEnd: 3. - env updateSelector: #modulation:; scale: 10.0. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>clarinet2 (in category 'instruments') ----- - clarinet2 - "FMSound clarinet2 play" - "(FMSound lowMajorScaleOn: FMSound clarinet2) play" - - | snd p env | - snd := FMClarinetSound new modulation: 0 ratio: 2. - - p := OrderedCollection new. - p add: 0 at 0.0; add: 60 at 1.0; add: 310 at 1.0; add: 350 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). - - p := OrderedCollection new. - p add: 0 at 0.0167; add: 60 at 0.106; add: 310 at 0.106; add: 350 at 0.0. - env := Envelope points: p loopStart: 2 loopEnd: 3. - env updateSelector: #modulation:; scale: 10.0. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - - ! Item was removed: - ----- Method: FMSound class>>default (in category 'instruments') ----- - default - - ^ self oboe1 - ! Item was removed: - ----- Method: FMSound class>>flute1 (in category 'instruments') ----- - flute1 - "FMSound flute1 play" - "(FMSound majorScaleOn: FMSound flute1) play" - - | snd p | - snd := FMSound new. - p := OrderedCollection new. - p add: 0 at 0; add: 20 at 1.0; add: 100 at 1.0; add: 120 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). - ^ snd setPitch: 440.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>flute2 (in category 'instruments') ----- - flute2 - "FMSound flute2 play" - "(FMSound majorScaleOn: FMSound flute2) play" - - | snd p | - snd := FMSound new. - p := OrderedCollection new. - p add: 0 at 0; add: 20 at 1.0; add: 100 at 1.0; add: 120 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). - snd addEnvelope: (RandomEnvelope for: #pitch:). - ^ snd setPitch: 440.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>initialize (in category 'class initialization') ----- - initialize - "Build a sine wave table." - "FMSound initialize" - - | tableSize radiansPerStep peak | - tableSize := 4000. - SineTable := SoundBuffer newMonoSampleCount: tableSize. - radiansPerStep := (2.0 * Float pi) / tableSize asFloat. - peak := ((1 bitShift: 15) - 1) asFloat. "range is +/- (2^15 - 1)" - 1 to: tableSize do: [:i | - SineTable at: i put: (peak * (radiansPerStep * (i - 1)) sin) rounded]. - ! Item was removed: - ----- Method: FMSound class>>marimba (in category 'instruments') ----- - marimba - "FMSound marimba play" - "(FMSound majorScaleOn: FMSound marimba) play" - - | snd p env | - snd := FMSound new modulation: 1 ratio: 0.98. - - p := OrderedCollection new. - p add: 0 at 1.0; add: 10 at 0.3; add: 40 at 0.1; add: 80 at 0.02; add: 120 at 0.1; add: 160 at 0.02; add: 220 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 4 loopEnd: 6). - - p := OrderedCollection new. - p add: 0 at 1.2; add: 80 at 0.85; add: 120 at 1.0; add: 160 at 0.85; add: 220 at 0.0. - env := Envelope points: p loopStart: 2 loopEnd: 4. - env updateSelector: #modulation:. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>mellowBrass (in category 'instruments') ----- - mellowBrass - "FMSound mellowBrass play" - "(FMSound lowMajorScaleOn: FMSound mellowBrass) play" - - | snd p env | - snd := FMSound new modulation: 0 ratio: 1. - - p := OrderedCollection new. - p add: 0 at 0.0; add: 70 at 0.325; add: 120 at 0.194; add: 200 at 0.194; add: 320 at 0.194; add: 380 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 3 loopEnd: 5). - - p := OrderedCollection new. - p add: 0 at 0.1; add: 70 at 0.68; add: 120 at 0.528; add: 200 at 0.519; add: 320 at 0.528; add: 380 at 0.0. - env := Envelope points: p loopStart: 3 loopEnd: 5. - env updateSelector: #modulation:; scale: 5.0. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>oboe1 (in category 'instruments') ----- - oboe1 - "FMSound oboe1 play" - "(FMSound majorScaleOn: FMSound oboe1) play" - - | snd p | - snd := FMSound new modulation: 1 ratio: 1. - p := OrderedCollection new. - p add: 0 at 0.0; add: 10 at 1.0; add: 100 at 1.0; add: 120 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). - ^ snd setPitch: 440.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>oboe2 (in category 'instruments') ----- - oboe2 - "FMSound oboe2 play" - "(FMSound majorScaleOn: FMSound oboe2) play" - - | snd p | - snd := FMSound new modulation: 1 ratio: 1. - p := OrderedCollection new. - p add: 0 at 0; add: 20 at 1.0; add: 100 at 1.0; add: 120 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). - snd addEnvelope: (RandomEnvelope for: #pitch:). - ^ snd setPitch: 440.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>organ1 (in category 'instruments') ----- - organ1 - "FMSound organ1 play" - "(FMSound majorScaleOn: FMSound organ1) play" - - | snd p | - snd := FMSound new. - p := OrderedCollection new. - p add: 0 at 0; add: 60 at 1.0; add: 110 at 0.8; add: 200 at 1.0; add: 250 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 4). - ^ snd setPitch: 440.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>pluckedElecBass (in category 'instruments') ----- - pluckedElecBass - "FMSound pluckedElecBass play" - "(FMSound lowMajorScaleOn: FMSound pluckedElecBass) play" - - | snd p env | - snd := FMSound new modulation: 1 ratio: 3.0. - - p := OrderedCollection new. - p add: 0 at 0.4; add: 20 at 1.0; add: 30 at 0.6; add: 100 at 0.6; add: 130 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 3 loopEnd: 4). - - p := OrderedCollection new. - p add: 0 at 1.0; add: 20 at 2.0; add: 30 at 4.5; add: 100 at 4.5; add: 130 at 0.0. - env := Envelope points: p loopStart: 3 loopEnd: 4. - env updateSelector: #modulation:. - snd addEnvelope: env. - - p := OrderedCollection new. - p add: 0 at 6.0; add: 20 at 4.0; add: 30 at 3.0; add: 100 at 3.0; add: 130 at 3.0. - env := Envelope points: p loopStart: 3 loopEnd: 4. - env updateSelector: #ratio:. - snd addEnvelope: env. - - ^ snd setPitch: 220.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>randomWeird1 (in category 'instruments') ----- - randomWeird1 - "FMSound randomWeird1 play" - - | snd p | - snd := FMSound new. - snd addEnvelope: (VolumeEnvelope exponentialDecay: 0.96). - p := Array with: 0 at 0 with: 100 at 1.0 with: 250 at 0.7 with: 400 at 1.0 with: 500 at 0. - snd addEnvelope: (PitchEnvelope points: p loopStart: 2 loopEnd: 4). - ^ snd setPitch: (150 + 2000 atRandom) dur: 2.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>randomWeird2 (in category 'instruments') ----- - randomWeird2 - "FMSound randomWeird2 play" - - | snd | - snd := FMSound new. - snd addEnvelope: (VolumeEnvelope exponentialDecay: 0.96). - snd addEnvelope: (PitchEnvelope exponentialDecay: 0.98). - ^ snd setPitch: (150 + 2000 atRandom) dur: 2.0 loudness: 0.5 - ! Item was removed: - ----- Method: FMSound class>>sineTable (in category 'class initialization') ----- - sineTable - "Answer a SoundBuffer containing one complete cycle of a sine wave." - - ^ SineTable - ! Item was removed: - ----- Method: FMSound>>duration (in category 'accessing') ----- - duration - - ^ initialCount asFloat / self samplingRate asFloat - ! Item was removed: - ----- Method: FMSound>>duration: (in category 'accessing') ----- - duration: seconds - - super duration: seconds. - count := initialCount := (seconds * self samplingRate) rounded. - ! Item was removed: - ----- Method: FMSound>>initialize (in category 'initialization') ----- - initialize - - super initialize. - waveTable := SineTable. - scaledWaveTableSize := waveTable size * ScaleFactor. - self setPitch: 440.0 dur: 1.0 loudness: 0.2. - ! Item was removed: - ----- Method: FMSound>>internalizeModulationAndRatio (in category 'accessing') ----- - internalizeModulationAndRatio - "Recompute the internal state for the modulation index and frequency ratio relative to the current pitch." - - modulation < 0.0 ifTrue: [modulation := modulation negated]. - multiplier < 0.0 ifTrue: [multiplier := multiplier negated]. - normalizedModulation := - ((modulation * scaledIndexIncr) / ScaleFactor) asInteger. - scaledOffsetIndexIncr := (multiplier * scaledIndexIncr) asInteger. - - "clip to maximum values if necessary" - normalizedModulation > MaxScaledValue ifTrue: [ - normalizedModulation := MaxScaledValue. - modulation := (normalizedModulation * ScaleFactor) asFloat / scaledIndexIncr]. - scaledOffsetIndexIncr > (scaledWaveTableSize // 2) ifTrue: [ - scaledOffsetIndexIncr := scaledWaveTableSize // 2. - multiplier := scaledOffsetIndexIncr asFloat / scaledIndexIncr]. - ! Item was removed: - ----- Method: FMSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play samples from a wave table by stepping a fixed amount through the table on every sample. The table index and increment are scaled to allow fractional increments for greater pitch accuracy." - "(FMSound pitch: 440.0 dur: 1.0 loudness: 0.5) play" - - | doingFM lastIndex sample offset i s | - <primitive:'primitiveMixFMSound' module:'SoundGenerationPlugin'> - <var: #aSoundBuffer declareC: 'short int *aSoundBuffer'> - <var: #waveTable declareC: 'short int *waveTable'> - - doingFM := (normalizedModulation ~= 0) and: [scaledOffsetIndexIncr ~= 0]. - lastIndex := (startIndex + n) - 1. - startIndex to: lastIndex do: [:sliceIndex | - sample := (scaledVol * (waveTable at: (scaledIndex // ScaleFactor) + 1)) // ScaleFactor. - doingFM - ifTrue: [ - offset := normalizedModulation * (waveTable at: (scaledOffsetIndex // ScaleFactor) + 1). - scaledOffsetIndex := (scaledOffsetIndex + scaledOffsetIndexIncr) \\ scaledWaveTableSize. - scaledOffsetIndex < 0 - ifTrue: [scaledOffsetIndex := scaledOffsetIndex + scaledWaveTableSize]. - scaledIndex := (scaledIndex + scaledIndexIncr + offset) \\ scaledWaveTableSize. - scaledIndex < 0 - ifTrue: [scaledIndex := scaledIndex + scaledWaveTableSize]] - ifFalse: [ - scaledIndex := (scaledIndex + scaledIndexIncr) \\ scaledWaveTableSize]. - - 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]. - - 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]]]. - - count := count - n. - ! Item was removed: - ----- Method: FMSound>>modulation (in category 'accessing') ----- - modulation - "Return the FM modulation index." - - ^ modulation - ! Item was removed: - ----- Method: FMSound>>modulation: (in category 'accessing') ----- - modulation: mod - "Set the FM modulation index. Typical values range from 0 (no modulation) to 5, although values up to about 10 are sometimes useful." - "Warning: This method is intended primarily for use by envelopes. For efficiency during envelope processing, this change will not take effect until internalizeModulationAndRatio is called." - - modulation := mod asFloat. - ! Item was removed: - ----- Method: FMSound>>modulation:multiplier: (in category 'accessing') ----- - modulation: mod multiplier: freqRatio - "For backward compatibility. Needed to read old .fmp files." - - self modulation: mod ratio: freqRatio. - ! Item was removed: - ----- Method: FMSound>>modulation:ratio: (in category 'accessing') ----- - modulation: mod ratio: freqRatio - "Set the modulation index and carrier to modulation frequency ratio for this sound, and compute the internal state that depends on these parameters." - - modulation := mod asFloat. - multiplier := freqRatio asFloat. - self internalizeModulationAndRatio. - ! Item was removed: - ----- Method: FMSound>>multiplier (in category 'accessing') ----- - multiplier - - ^ multiplier - ! Item was removed: - ----- Method: FMSound>>pitch (in category 'accessing') ----- - pitch - - ^ (self samplingRate asFloat * scaledIndexIncr / ScaleFactor) asFloat / waveTable size - ! Item was removed: - ----- Method: FMSound>>pitch: (in category 'accessing') ----- - pitch: p - "Warning: Since the modulation and ratio are relative to the current pitch, some internal state must be recomputed when the pitch is changed. However, for efficiency during envelope processing, this compuation will not be done until internalizeModulationAndRatio is called." - - scaledIndexIncr := - ((p asFloat * waveTable size asFloat * ScaleFactor asFloat) / self samplingRate asFloat) asInteger - min: (waveTable size // 2) * ScaleFactor. - ! Item was removed: - ----- Method: FMSound>>ratio (in category 'accessing') ----- - ratio - "Return the FM modulation to carrier frequency ratio." - - ^ multiplier - ! Item was removed: - ----- Method: FMSound>>ratio: (in category 'accessing') ----- - ratio: freqRatio - "Set the FM modulation to carrier frequency ratio." - "Warning: This method is intended primarily for use by envelopes. For efficiency during envelope processing, this change will not take effect until internalizeModulationAndRatio is called." - - multiplier := freqRatio asFloat. - ! Item was removed: - ----- Method: FMSound>>reset (in category 'sound generation') ----- - reset - - self internalizeModulationAndRatio. - super reset. - count := initialCount. - scaledIndex := 0. - scaledOffsetIndex := 0. - ! Item was removed: - ----- Method: FMSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - ^ count - ! Item was removed: - ----- Method: FMSound>>setPitch:dur:loudness: (in category 'initialization') ----- - setPitch: pitchNameOrNumber dur: d loudness: vol - "(FMSound pitch: 'a4' dur: 2.5 loudness: 0.4) play" - - super setPitch: pitchNameOrNumber dur: d loudness: vol. - modulation ifNil: [modulation := 0.0]. - multiplier ifNil: [multiplier := 0.0]. - self pitch: (self nameOrNumberToPitch: pitchNameOrNumber). - self reset. - ! Item was removed: - ----- Method: FMSound>>setWavetable: (in category 'initialization') ----- - setWavetable: anArray - "(AbstractSound lowMajorScaleOn: (FMSound new setWavetable: AA)) play" - - | samples p dur vol | - "copy the array into a SoundBuffer if necessary" - anArray class isPointers - ifTrue: [samples := SoundBuffer fromArray: anArray] - ifFalse: [samples := anArray]. - - p := self pitch. - dur := self duration. - vol := self loudness. - waveTable := samples. - scaledWaveTableSize := waveTable size * ScaleFactor. - self setPitch: p dur: dur loudness: vol. - ! Item was removed: - ----- Method: FMSound>>stopAfterMSecs: (in category 'sound generation') ----- - stopAfterMSecs: mSecs - "Terminate this sound this note after the given number of milliseconds." - - count := (mSecs * self samplingRate) // 1000. - ! Item was removed: - ----- Method: FMSound>>storeOn: (in category 'storing') ----- - storeOn: strm - | env | - strm nextPutAll: '(((FMSound'; - nextPutAll: ' pitch: '; print: self pitch; - nextPutAll: ' dur: '; print: self duration; - nextPutAll: ' loudness: '; print: self loudness; nextPutAll: ')'; - nextPutAll: ' modulation: '; print: self modulation; - nextPutAll: ' ratio: '; print: self ratio; nextPutAll: ')'. - 1 to: envelopes size do: - [:i | env := envelopes at: i. - strm cr; nextPutAll: ' addEnvelope: '. env storeOn: strm. - i < envelopes size ifTrue: [strm nextPutAll: ';']]. - strm nextPutAll: ')'. - ! Item was removed: - Object subclass: #FWT - instanceVariableNames: 'alpha beta coeffs h g hTilde gTilde samples nSamples nLevels transform' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !FWT commentStamp: '<historical>' prior: 0! - This class implements the Fast Wavelet Transform. It follows Mac Cody's article in Dr. Dobb's Journal, April 1992. See also... - http://www.dfw.net/~mcody/fwt/fwt.html - - Notable features of his implementation include... - 1. The ability to generate a large family of wavelets (including the Haar (alpha=beta) and Daubechies) from two parameters, alpha and beta, which range between -pi and pi. - 2. All data arrays have 5 elements added on to allow for convolution overrun with filters up to 6 in length (the max for this implementation). - 3. After a forward transform, the detail coefficients of the deomposition are found in transform at: 2*i, for i = 1, 2, ... nLevels; and the approximation coefficients are in transform at: (2*nLevels-1). these together comprise the complete wavelet transform. - - The following changes from cody's listings should also be noted... - 1. The three DotProduct routines have been merged into one. - 2. The four routines WaveletDecomposition, DecomposeBranches, WaveletReconstruction, ReconstructBranches have all been merged into transformForward:. - 3. All indexing follows the Smalltalk 1-to-N convention, naturally.! Item was removed: - ----- Method: FWT>>coeffs (in category 'access') ----- - coeffs - "Return all coefficients needed to reconstruct the original samples" - | header csize strm | - header := Array with: nSamples with: nLevels with: alpha with: beta. - csize := header size. - 1 to: nLevels do: [:i | csize := csize + (transform at: i*2) size]. - csize := csize + (transform at: nLevels*2-1) size. - coeffs := Array new: csize. - strm := WriteStream on: coeffs. - strm nextPutAll: header. - 1 to: nLevels do: [:i | strm nextPutAll: (transform at: i*2)]. - strm nextPutAll: (transform at: nLevels*2-1). - ^ coeffs! Item was removed: - ----- Method: FWT>>coeffs: (in category 'access') ----- - coeffs: coeffArray - "Initialize this instance from the given coeff array (including header)." - | header strm | - strm := ReadStream on: coeffArray. - header := strm next: 4. - self nSamples: header first nLevels: header second. - self setAlpha: header third beta: header fourth. - 1 to: nLevels do: [:i | transform at: i*2 put: (strm next: (transform at: i*2) size)]. - transform at: nLevels*2-1 put: (strm next: (transform at: nLevels*2-1) size). - strm atEnd ifFalse: [self error: 'Data size error']. - ! Item was removed: - ----- Method: FWT>>convolveAndDec:dataLen:filter:out: (in category 'computation') ----- - convolveAndDec: inData dataLen: inLen filter: filter out: outData - "convolve the input sequence with the filter and decimate by two" - | filtLen offset outi dotp | - filtLen := filter size. - outi := 1. - 1 to: inLen+9 by: 2 do: - [:i | - i < filtLen - ifTrue: - [dotp := self dotpData: inData endIndex: i filter: filter - start: 1 stop: i inc: 1] - ifFalse: - [i > (inLen+5) - ifTrue: - [offset := i - (inLen+5). - dotp := self dotpData: inData endIndex: inLen+5 filter: filter - start: 1+offset stop: filtLen inc: 1] - ifFalse: - [dotp := self dotpData: inData endIndex: i filter: filter - start: 1 stop: filtLen inc: 1]]. - outData at: outi put: dotp. - outi := outi + 1]! Item was removed: - ----- Method: FWT>>convolveAndInt:dataLen:filter:sumOutput:into: (in category 'computation') ----- - convolveAndInt: inData dataLen: inLen filter: filter sumOutput: - sumOutput into: outData - "insert zeros between each element of the input sequence and - convolve with the filter to interpolate the data" - | outi filtLen oddTerm evenTerm j | - outi := 1. - filtLen := filter size. - - "every other dot product interpolates the data" - filtLen // 2 to: inLen + filtLen - 2 do: - [:i | - oddTerm := self dotpData: inData endIndex: i filter: filter - start: 2 stop: filter size inc: 2. - evenTerm := self dotpData: inData endIndex: i+1 filter: filter - start: 1 stop: filter size inc: 2. - sumOutput - ifTrue: - ["summation with previous convolution if true" - outData at: outi put: (outData at: outi) + oddTerm. - outData at: outi+1 put: (outData at: outi+1) + evenTerm] - ifFalse: - ["first convolution of pair if false" - outData at: outi put: oddTerm. - outData at: outi+1 put: evenTerm]. - outi := outi + 2]. - - "Ought to be able to fit this last term into the above loop." - j := inLen + filtLen - 1. - oddTerm := self dotpData: inData endIndex: j filter: filter - start: 2 stop: filter size inc: 2. - sumOutput - ifTrue: [outData at: outi put: (outData at: outi) + oddTerm] - ifFalse: [outData at: outi put: oddTerm]. - ! Item was removed: - ----- Method: FWT>>doWaveDemo (in category 'testing') ----- - doWaveDemo "FWT new doWaveDemo" - "Printing the above should yield a small number -- I get 1.1e-32" - | originalData | - self nSamples: 312 nLevels: 3. - self setAlpha: 0.0 beta: 0.0. - - "Install a sine wave as sample data" - self samples: ((1 to: nSamples) collect: [:i | ((i-1) * 0.02 * Float pi) sin] as: Float64Array). - originalData := samples copy. - FFT new plot: (samples copyFrom: 1 to: nSamples) in: (0 at 0 extent: nSamples at 100). - - "Transform forward and plot the decomposition" - self transformForward: true. - transform withIndexDo: - [:w :i | - FFT new plot: (w copyFrom: 1 to: w size-5) - in: (i-1\\2*320@(i+1//2*130) extent: (w size-5)@100)]. - - "Test copy out and read in the transform coefficients" - self coeffs: self coeffs. - - "Ttransform back, plot the reconstruction, and return the error figure" - self transformForward: false. - FFT new plot: (samples copyFrom: 1 to: nSamples) in: (320 at 0 extent: nSamples at 100). - ^ self meanSquareError: originalData! Item was removed: - ----- Method: FWT>>dotpData:endIndex:filter:start:stop:inc: (in category 'computation') ----- - dotpData: data endIndex: endIndex filter: filter start: start stop: stop inc: inc - | sum i j | - sum := 0.0. - j := endIndex. - i := start. - [i <= stop] whileTrue: - [sum := sum + ((data at: j) * (filter at: i)). - i := i + inc. - j := j - 1]. - ^ sum! Item was removed: - ----- Method: FWT>>meanSquareError: (in category 'testing') ----- - meanSquareError: otherData - "Return the mean-square error between the current sample array and - some other data, presumably to evaluate a compression scheme." - | topSum bottomSum pointDiff | - topSum := bottomSum := 0.0. - 1 to: nSamples do: - [:i | pointDiff := (samples at: i) - (otherData at: i). - topSum := topSum + (pointDiff * pointDiff). - bottomSum := bottomSum + ((otherData at: i) * (otherData at: i))]. - ^ topSum / bottomSum! Item was removed: - ----- Method: FWT>>nSamples:nLevels: (in category 'initialization') ----- - nSamples: n nLevels: nLevs - "Initialize a wavelet transform." - "Note the sample array size must be N + 5, where N is a multiple of 2^nLevels" - | dyadSize | - (n // (1 bitShift: nLevs)) > 0 ifFalse: [self error: 'Data size error']. - (n \\ (1 bitShift: nLevs)) = 0 ifFalse: [self error: 'Data size error']. - nSamples := n. - samples := Float64Array new: n + 5. - nLevels := nLevs. - transform := Array new: nLevels*2. "Transformed data is stored as a tree of coeffs" - dyadSize := nSamples. - 1 to: nLevels do: - [:i | dyadSize := dyadSize // 2. - transform at: 2*i-1 put: (Float64Array new: dyadSize + 5). - transform at: 2*i put: (Float64Array new: dyadSize + 5)]! Item was removed: - ----- Method: FWT>>samples (in category 'access') ----- - samples - ^ samples copyFrom: 1 to: nSamples! Item was removed: - ----- Method: FWT>>samples: (in category 'access') ----- - samples: anArray - 1 to: anArray size do: - [:i | samples at: i put: (anArray at: i)]. - nSamples+1 to: nSamples+5 do: - [:i | samples at: i put: 0.0]! Item was removed: - ----- Method: FWT>>setAlpha:beta: (in category 'initialization') ----- - setAlpha: alph beta: bet - "Set alpha and beta, compute wavelet coeefs, and derive hFilter and lFilter" - | tcosa tcosb tsina tsinb | - alpha := alph. - beta := bet. - - "WaveletCoeffs..." - "precalculate cosine of alpha and sine of beta" - tcosa := alpha cos. - tcosb := beta cos. - tsina := alpha sin. - tsinb := beta sin. - coeffs := Float64Array new: 6. - - "calculate first two wavelet coefficients a := a(-2) and b := a(-1)" - coeffs at: 1 put: ((1.0 + tcosa + tsina) * (1.0 - tcosb - tsinb) - + (2.0 * tsinb * tcosa)) / 4.0. - coeffs at: 2 put: ((1.0 - tcosa + tsina) * (1.0 + tcosb - tsinb) - - (2.0 * tsinb * tcosa)) / 4.0. - - "precalculate cosine and sine of alpha minus beta" - tcosa := (alpha - beta) cos. - tsina := (alpha - beta) sin. - - "calculate last four wavelet coefficients c := a(0), d := a(1), e := a(2), and f := a(3)" - coeffs at: 3 put: (1.0 + tcosa + tsina) / 2.0. - coeffs at: 4 put: (1.0 + tcosa - tsina) / 2.0. - coeffs at: 5 put: 1.0 - (coeffs at: 1) - (coeffs at: 3). - coeffs at: 6 put: 1.0 - (coeffs at: 2) - (coeffs at: 4). - - "MakeFiltersFromCoeffs..." - "Select the non-zero wavelet coefficients" - coeffs := coeffs copyFrom: (coeffs findFirst: [:c | c abs > 1.0e-14]) - to: (coeffs findLast: [:c | c abs > 1.0e-14]). - - "Form the low pass and high pass filters for decomposition" - hTilde := coeffs reversed collect: [:c | c / 2.0]. - gTilde := coeffs collect: [:c | c / 2.0]. - 1 to: gTilde size by: 2 do: - [:i | gTilde at: i put: (gTilde at: i) negated]. - - "Form the low pass and high pass filters for reconstruction" - h := coeffs copy. - g := coeffs reversed. - 2 to: g size by: 2 do: - [:i | g at: i put: (g at: i) negated] - ! Item was removed: - ----- Method: FWT>>transformForward: (in category 'computation') ----- - transformForward: forward - | inData inLen outData | - forward - ifTrue: - ["first InData is input signal, following are intermediate approx coefficients" - inData := samples. inLen := nSamples. - 1 to: nLevels do: - [:i | - self convolveAndDec: inData dataLen: inLen - filter: hTilde out: (transform at: 2*i-1). - self convolveAndDec: inData dataLen: inLen - filter: gTilde out: (transform at: 2*i). - inData := transform at: 2*i-1. inLen := inLen // 2]] - ifFalse: - [inLen := nSamples >> nLevels. - "all but last outData are next higher intermediate approximations, - last is final reconstruction of samples" - nLevels to: 1 by: -1 do: - [:i | - outData := i = 1 ifTrue: [samples] - ifFalse: [transform at: 2*(i-1)-1]. - self convolveAndInt: (transform at: 2*i-1) dataLen: inLen - filter: h sumOutput: false into: outData. - self convolveAndInt: (transform at: 2*i) dataLen: inLen - filter: g sumOutput: true into: outData. - inLen := inLen * 2]] - ! Item was removed: - ----- Method: FWT>>viewPhiAndPsi (in category 'testing') ----- - viewPhiAndPsi "(FWT new nSamples: 256 nLevels: 6) viewPhiAndPsi" - "View the scaling function and mother wavelets for this transform" - | p | - Display fillWhite: (0 at 0 extent: 300 at 300). - Display border: (0 at 0 extent: 300 at 300) width: 2. - [Sensor anyButtonPressed] whileFalse: - ["Move mouse around in the outer rectangle to explore" - p := Sensor cursorPoint min: 300 at 300. - self setAlpha: (p x - 150) / 150.0 * Float pi - beta: (p y - 150) / 150.0 * Float pi. - 'alpha=', (alpha printShowingMaxDecimalPlaces: 2), ' ', - 'beta=', (beta printShowingMaxDecimalPlaces: 2), ' ' displayAt: 50 at 5. - transform do: [:w | w atAllPut: 0.0]. - (transform at: transform size - 1) at: (nSamples>>nLevels) put: 1.0. - self transformForward: false. - FFT new plot: (samples copyFrom: 1 to: nSamples) in: (20 at 30 extent: nSamples at 100). - - transform do: [:w | w atAllPut: 0.0]. - (transform at: transform size) at: (nSamples>>nLevels) put: 1.0. - self transformForward: false. - FFT new plot: (samples copyFrom: 1 to: nSamples) in: (20 at 170 extent: nSamples at 100)]. - Sensor waitNoButton! Item was removed: - SoundCodec subclass: #GSMCodec - instanceVariableNames: 'encodeState decodeState' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: GSMCodec class>>new (in category 'instance creation') ----- - new - - ^ super new reset - ! Item was removed: - ----- Method: GSMCodec>>bytesPerEncodedFrame (in category 'subclass responsibilities') ----- - bytesPerEncodedFrame - - ^ 33 - ! Item was removed: - ----- Method: GSMCodec>>decodeFrames:from:at:into:at: (in category 'subclass responsibilities') ----- - decodeFrames: frameCount from: srcByteArray at: srcIndex into: dstSoundBuffer at: dstIndex - - | p | - p := self primDecode: decodeState frames: frameCount - from: srcByteArray at: srcIndex - into: dstSoundBuffer at: dstIndex. - ^ Array with: p x with: p y - ! Item was removed: - ----- Method: GSMCodec>>encodeFrames:from:at:into:at: (in category 'subclass responsibilities') ----- - encodeFrames: frameCount from: srcSoundBuffer at: srcIndex into: dstByteArray at: dstIndex - - | p | - p := self primEncode: encodeState frames: frameCount - from: srcSoundBuffer at: srcIndex - into: dstByteArray at: dstIndex. - ^ Array with: p x with: p y - ! Item was removed: - ----- Method: GSMCodec>>primDecode:frames:from:at:into:at: (in category 'primitives') ----- - primDecode: state frames: frameCount from: srcSoundBuffer at: srcIndex into: dstByteArray at: dstIndex - - <primitive: 'primitiveGSMDecode' module: 'SoundCodecPrims'> - self primitiveFailed. - ! Item was removed: - ----- Method: GSMCodec>>primEncode:frames:from:at:into:at: (in category 'primitives') ----- - primEncode: state frames: frameCount from: srcSoundBuffer at: srcIndex into: dstByteArray at: dstIndex - - <primitive: 'primitiveGSMEncode' module: 'SoundCodecPrims'> - self primitiveFailed. - ! Item was removed: - ----- Method: GSMCodec>>primNewState (in category 'primitives') ----- - primNewState - - <primitive: 'primitiveGSMNewState' module: 'SoundCodecPrims'> - self error: 'The SoundCodecPrims plugin is not available'. - ! Item was removed: - ----- Method: GSMCodec>>reset (in category 'subclass responsibilities') ----- - reset - "Reset my encoding/decoding state to prepare to encode or decode a new sound stream." - - encodeState := self primNewState. - decodeState := self primNewState. - ! Item was removed: - ----- Method: GSMCodec>>samplesPerFrame (in category 'subclass responsibilities') ----- - samplesPerFrame - - ^ 160 - ! Item was removed: - AbstractSound subclass: #LoopedSampledSound - instanceVariableNames: 'initialCount count releaseCount sampleCountForRelease leftSamples rightSamples originalSamplingRate perceivedPitch gain firstSample lastSample loopEnd scaledLoopLength scaledIndex scaledIndexIncr' - classVariableNames: 'FloatLoopIndexScaleFactor LoopIndexFractionMask LoopIndexScaleFactor' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !LoopedSampledSound commentStamp: '<historical>' prior: 0! - I respresent a sequence of sound samples, often used to record a single note played by a real instrument. I can be pitch-shifted up or down, and can include a looped portion to allow a sound to be sustained indefinitely. - ! Item was removed: - ----- Method: LoopedSampledSound class>>fromAIFFFileNamed:mergeIfStereo: (in category 'instance creation') ----- - fromAIFFFileNamed: fileName mergeIfStereo: mergeFlag - "Initialize this sound from the data in the given AIFF file. If mergeFlag is true and the file is stereo, its left and right channels are mixed together to produce a mono sampled sound." - - | aiffFileReader | - aiffFileReader := AIFFFileReader new. - aiffFileReader readFromFile: fileName - mergeIfStereo: mergeFlag - skipDataChunk: false. - self new fromAIFFFileReader: aiffFileReader mergeIfStereo: mergeFlag! Item was removed: - ----- Method: LoopedSampledSound class>>initialize (in category 'class initialization') ----- - initialize - "LoopedSampledSound initialize" - - LoopIndexScaleFactor := 512. - FloatLoopIndexScaleFactor := LoopIndexScaleFactor asFloat. - LoopIndexFractionMask := LoopIndexScaleFactor - 1. - ! Item was removed: - ----- Method: LoopedSampledSound class>>samples:loopEnd:loopLength:pitch:samplingRate: (in category 'instance creation') ----- - samples: aSoundBuffer loopEnd: loopEndIndex loopLength: loopSampleCount pitch: perceivedPitchInHz samplingRate: samplingRateInHz - "See the comment in the instance method of this name." - - ^ self basicNew - samples: aSoundBuffer - loopEnd: loopEndIndex - loopLength: loopSampleCount - pitch: perceivedPitchInHz - samplingRate: samplingRateInHz - ! Item was removed: - ----- Method: LoopedSampledSound class>>unloopedSamples:pitch:samplingRate: (in category 'instance creation') ----- - unloopedSamples: aSoundBuffer pitch: perceivedPitchInHz samplingRate: samplingRateInHz - "See the comment in the instance method of this name." - - ^ self basicNew - unloopedSamples: aSoundBuffer - pitch: perceivedPitchInHz - samplingRate: samplingRateInHz - ! Item was removed: - ----- Method: LoopedSampledSound>>addReleaseEnvelope (in category 'initialization') ----- - addReleaseEnvelope - "Add a simple release envelope to this sound." - - | p env | - p := OrderedCollection new. - p add: 0 at 1.0; add: 10 at 1.0; add: 100 at 1.0; add: 120 at 0.0. - env := (VolumeEnvelope points: p loopStart: 2 loopEnd: 3) target: self. - envelopes size > 0 ifTrue: [ "remove any existing volume envelopes" - envelopes copy do: [:e | - (e isKindOf: VolumeEnvelope) ifTrue: [self removeEnvelope: e]]]. - self addEnvelope: env. - ! Item was removed: - ----- Method: LoopedSampledSound>>beUnlooped (in category 'accessing') ----- - beUnlooped - - scaledLoopLength := 0. - ! Item was removed: - ----- Method: LoopedSampledSound>>comeFullyUpOnReload: (in category 'disk i/o') ----- - comeFullyUpOnReload: smartRefStream - "Convert my sample buffers from ByteArrays into SampleBuffers after raw loading from a DataStream. Answer myself." - - leftSamples == rightSamples - ifTrue: [ - leftSamples := SoundBuffer fromByteArray: self leftSamples. - rightSamples := leftSamples] - ifFalse: [ - leftSamples := SoundBuffer fromByteArray: self leftSamples. - rightSamples := SoundBuffer fromByteArray: self rightSamples]. - - ! Item was removed: - ----- Method: LoopedSampledSound>>computeSampleCountForRelease (in category 'initialization') ----- - computeSampleCountForRelease - "Calculate the number of samples before the end of the note after which looping back will be be disabled. The units of this value, sampleCountForRelease, are samples at the original sampling rate. When playing a specific note, this value is converted to releaseCount, which is number of samples to be computed at the current pitch and sampling rate." - "Details: For short loops, set the sampleCountForRelease to the loop length plus the number of samples between loopEnd and lastSample. Otherwise, set it to 1/10th of a second worth of samples plus the number of samples between loopEnd and lastSample. In this case, the trailing samples will be played only if the last loop-back occurs within 1/10th of a second of the total note duration, and the note may be shortened by up to 1/10th second. For long loops, this is the best we can do." - - (scaledLoopLength > 0 and: [lastSample > loopEnd]) - ifTrue: [ - sampleCountForRelease := (lastSample - loopEnd) + - (self loopLength min: (originalSamplingRate / 10.0)) asInteger] - ifFalse: [sampleCountForRelease := 0]. - - releaseCount := sampleCountForRelease. - ! Item was removed: - ----- Method: LoopedSampledSound>>copyDownSampledLowPassFiltering: (in category 'other') ----- - copyDownSampledLowPassFiltering: doFiltering - "Answer a copy of the receiver at half its sampling rate. The result consumes half the memory space, but has only half the frequency range of the original. If doFiltering is true, the original sound buffers are low-pass filtered before down-sampling. This is slower, but prevents aliasing of any high-frequency components of the original signal. (While it may be possible to avoid low-pass filtering when down-sampling from 44.1 kHz to 22.05 kHz, it is probably essential when going to lower sampling rates.)" - - ^ self copy downSampleLowPassFiltering: doFiltering - ! Item was removed: - ----- Method: LoopedSampledSound>>downSampleLowPassFiltering: (in category 'private') ----- - downSampleLowPassFiltering: doFiltering - "Cut my sampling rate in half. Use low-pass filtering (slower) if doFiltering is true." - "Note: This operation loses information, and modifies the receiver in place." - - | stereo newLoopLength | - stereo := self isStereo. - leftSamples := leftSamples downSampledLowPassFiltering: doFiltering. - stereo - ifTrue: [rightSamples := rightSamples downSampledLowPassFiltering: doFiltering] - ifFalse: [rightSamples := leftSamples]. - originalSamplingRate := originalSamplingRate / 2.0. - loopEnd odd - ifTrue: [newLoopLength := (self loopLength / 2.0) + 0.5] - ifFalse: [newLoopLength := self loopLength / 2.0]. - firstSample := (firstSample + 1) // 2. - lastSample := (lastSample + 1) // 2. - loopEnd := (loopEnd + 1) // 2. - scaledLoopLength := (newLoopLength * LoopIndexScaleFactor) asInteger. - scaledIndexIncr := scaledIndexIncr // 2. - ! Item was removed: - ----- Method: LoopedSampledSound>>duration (in category 'accessing') ----- - duration - "Answer the duration of this sound in seconds." - - ^ initialCount asFloat / self samplingRate asFloat - ! Item was removed: - ----- Method: LoopedSampledSound>>duration: (in category 'accessing') ----- - duration: seconds - - super duration: seconds. - count := initialCount := (seconds * self samplingRate) rounded. - ! Item was removed: - ----- Method: LoopedSampledSound>>fftAt: (in category 'other') ----- - fftAt: startIndex - "Answer the Fast Fourier Transform (FFT) of my samples (only the left channel, if stereo) starting at the given index." - - | availableSamples fftWinSize | - availableSamples := (leftSamples size - startIndex) + 1. - fftWinSize := 2 raisedTo: (((availableSamples - 1) log: 2) truncated + 1). - fftWinSize := fftWinSize min: 4096. - fftWinSize > availableSamples ifTrue: [fftWinSize := fftWinSize / 2]. - ^ self fftWindowSize: fftWinSize startingAt: startIndex - ! Item was removed: - ----- Method: LoopedSampledSound>>fftWindowSize:startingAt: (in category 'private') ----- - fftWindowSize: windowSize startingAt: startIndex - "Answer a Fast Fourier Transform (FFT) of the given number of samples starting at the given index (the left channel only, if stereo). The window size will be rounded up to the nearest power of two greater than the requested size. There must be enough samples past the given starting index to accomodate this window size." - - | nu n fft | - nu := ((windowSize - 1) log: 2) truncated + 1. - n := 2 raisedTo: nu. - fft := FFT new nu: nu. - fft realData: ((startIndex to: startIndex + n - 1) collect: [:i | leftSamples at: i]). - ^ fft transformForward: true. - ! Item was removed: - ----- Method: LoopedSampledSound>>findStartPointAfter: (in category 'other') ----- - findStartPointAfter: index - "Answer the index of the last zero crossing sample before the given index." - - | i | - i := index min: lastSample. - - "scan backwards to the last zero-crossing" - (leftSamples at: i) > 0 - ifTrue: [ - [i > 1 and: [(leftSamples at: i) > 0]] whileTrue: [i := i - 1]] - ifFalse: [ - [i > 1 and: [(leftSamples at: i) < 0]] whileTrue: [i := i - 1]]. - ^ i - ! Item was removed: - ----- Method: LoopedSampledSound>>findStartPointForThreshold: (in category 'other') ----- - findStartPointForThreshold: threshold - "Answer the index of the last zero crossing sample before the first sample whose absolute value (in either the right or left channel) exceeds the given threshold." - - | i | - i := self indexOfFirstPointOverThreshold: threshold. - i >= lastSample ifTrue: [^ self error: 'no sample exceeds the given threshold']. - - "scan backwards to the last zero-crossing" - (leftSamples at: i) > 0 - ifTrue: [ - [i > 1 and: [(leftSamples at: i) > 0]] whileTrue: [i := i - 1]] - ifFalse: [ - [i > 1 and: [(leftSamples at: i) < 0]] whileTrue: [i := i - 1]]. - ^ i - ! Item was removed: - ----- Method: LoopedSampledSound>>firstSample (in category 'accessing') ----- - firstSample - - ^ firstSample - ! Item was removed: - ----- Method: LoopedSampledSound>>firstSample: (in category 'accessing') ----- - firstSample: aNumber - - firstSample := (aNumber asInteger max: 1) min: lastSample. - ! Item was removed: - ----- Method: LoopedSampledSound>>fromAIFFFileNamed:mergeIfStereo: (in category 'initialization') ----- - fromAIFFFileNamed: fileName mergeIfStereo: mergeFlag - "Initialize this sound from the data in the given AIFF file. If mergeFlag is true and the file is stereo, its left and right channels are mixed together to produce a mono sampled sound." - - | aiffFileReader | - aiffFileReader := AIFFFileReader new. - aiffFileReader readFromFile: fileName - mergeIfStereo: mergeFlag - skipDataChunk: false. - aiffFileReader isLooped - ifTrue: [ - self samples: aiffFileReader leftSamples - loopEnd: aiffFileReader loopEnd - loopLength: aiffFileReader loopLength - pitch: aiffFileReader pitch - samplingRate: aiffFileReader samplingRate] - ifFalse: [ - self unloopedSamples: aiffFileReader leftSamples - pitch: aiffFileReader pitch - samplingRate: aiffFileReader samplingRate]. - - "the following must be done second, since the initialization above sets - leftSamples and rightSamples to the same sample data" - aiffFileReader isStereo - ifTrue: [rightSamples := aiffFileReader rightSamples]. - - initialCount := (leftSamples size * self samplingRate) // originalSamplingRate. - self loudness: 1.0. - - self addReleaseEnvelope. - ! Item was removed: - ----- Method: LoopedSampledSound>>fromAIFFFileReader:mergeIfStereo: (in category 'initialization') ----- - fromAIFFFileReader: aiffFileReader mergeIfStereo: mergeFlag - "Initialize this sound from the data in the given AIFF file. If mergeFlag is true and the file is stereo, its left and right channels are mixed together to produce a mono sampled sound." - - aiffFileReader isLooped - ifTrue: [ - self samples: aiffFileReader leftSamples - loopEnd: aiffFileReader loopEnd - loopLength: aiffFileReader loopLength - pitch: aiffFileReader pitch - samplingRate: aiffFileReader samplingRate] - ifFalse: [ - self unloopedSamples: aiffFileReader leftSamples - pitch: aiffFileReader pitch - samplingRate: aiffFileReader samplingRate]. - - "the following must be done second, since the initialization above sets - leftSamples and rightSamples to the same sample data" - aiffFileReader isStereo - ifTrue: [rightSamples := aiffFileReader rightSamples]. - - initialCount := (leftSamples size * self samplingRate) // originalSamplingRate. - self loudness: 1.0. - - self addReleaseEnvelope. - ! Item was removed: - ----- Method: LoopedSampledSound>>gain (in category 'accessing') ----- - gain - - ^ gain - ! Item was removed: - ----- Method: LoopedSampledSound>>gain: (in category 'accessing') ----- - gain: aNumber - - gain := aNumber asFloat. - ! Item was removed: - ----- Method: LoopedSampledSound>>highestSignificantFrequencyAt: (in category 'other') ----- - highestSignificantFrequencyAt: startIndex - "Answer the highest significant frequency in the sample window starting at the given index. The a frequency is considered significant if it's power is at least 1/50th that of the maximum frequency component in the frequency spectrum." - - | fft powerArray threshold indices | - fft := self fftAt: startIndex. - powerArray := self normalizedResultsFromFFT: fft. - threshold := powerArray max / 50.0. - indices := (1 to: powerArray size) select: [:i | (powerArray at: i) > threshold]. - ^ originalSamplingRate / (fft samplesPerCycleForIndex: indices last) - ! Item was removed: - ----- Method: LoopedSampledSound>>indexOfFirstPointOverThreshold: (in category 'other') ----- - indexOfFirstPointOverThreshold: threshold - "Answer the index of the first sample whose absolute value exceeds the given threshold." - - | s | - leftSamples == rightSamples - ifTrue: [ - 1 to: lastSample do: [:i | - s := leftSamples at: i. - s < 0 ifTrue: [s := 0 - s]. - s > threshold ifTrue: [^ i]]] - ifFalse: [ - 1 to: lastSample do: [:i | - s := leftSamples at: i. - s < 0 ifTrue: [s := 0 - s]. - s > threshold ifTrue: [^ i]. - s := rightSamples at: i. - s < 0 ifTrue: [s := 0 - s]. - s > threshold ifTrue: [^ i]]]. - ^ lastSample + 1 - ! Item was removed: - ----- Method: LoopedSampledSound>>initialize (in category 'initialization') ----- - initialize - "This default initialization creates a loop consisting of a single cycle of a sine wave." - "(LoopedSampledSound pitch: 440.0 dur: 1.0 loudness: 0.4) play" - - | samples | - super initialize. - samples := FMSound sineTable. - self samples: samples - loopEnd: samples size - loopLength: samples size - pitch: 1.0 - samplingRate: samples size. - self addReleaseEnvelope. - self setPitch: 440.0 dur: 1.0 loudness: 0.5. - ! Item was removed: - ----- Method: LoopedSampledSound>>isLooped (in category 'accessing') ----- - isLooped - - ^ scaledLoopLength ~= 0. "zero loop length means unlooped" - ! Item was removed: - ----- Method: LoopedSampledSound>>isStereo (in category 'accessing') ----- - isStereo - - ^ leftSamples ~~ rightSamples - ! Item was removed: - ----- Method: LoopedSampledSound>>leftSamples (in category 'accessing') ----- - leftSamples - - ^ leftSamples - ! Item was removed: - ----- Method: LoopedSampledSound>>leftSamples: (in category 'accessing') ----- - leftSamples: aSampleBuffer - - leftSamples := aSampleBuffer. - ! Item was removed: - ----- Method: LoopedSampledSound>>loopEnd (in category 'accessing') ----- - loopEnd - - ^ loopEnd - ! Item was removed: - ----- Method: LoopedSampledSound>>loopLength (in category 'accessing') ----- - loopLength - - ^ scaledLoopLength / FloatLoopIndexScaleFactor - ! Item was removed: - ----- Method: LoopedSampledSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play samples from a wave table by stepping a fixed amount through the table on every sample. The table index and increment are scaled to allow fractional increments for greater pitch accuracy. If a loop length is specified, then the index is looped back when the loopEnd index is reached until count drops below releaseCount. This allows a short sampled sound to be sustained indefinitely." - "(LoopedSampledSound pitch: 440.0 dur: 5.0 loudness: 0.5) play" - - | lastIndex sampleIndex i s compositeLeftVol compositeRightVol nextSampleIndex m isInStereo rightVal leftVal | - <primitive:'primitiveMixLoopedSampledSound' module:'SoundGenerationPlugin'> - <var: #aSoundBuffer declareC: 'short int *aSoundBuffer'> - <var: #leftSamples declareC: 'short int *leftSamples'> - <var: #rightSamples declareC: 'short int *rightSamples'> - - isInStereo := leftSamples ~~ rightSamples. - compositeLeftVol := (leftVol * scaledVol) // ScaleFactor. - compositeRightVol := (rightVol * scaledVol) // ScaleFactor. - - i := (2 * startIndex) - 1. - lastIndex := (startIndex + n) - 1. - startIndex to: lastIndex do: [:sliceIndex | - sampleIndex := (scaledIndex := scaledIndex + scaledIndexIncr) // LoopIndexScaleFactor. - ((sampleIndex > loopEnd) and: [count > releaseCount]) ifTrue: [ - "loop back if not within releaseCount of the note end" - "note: unlooped sounds will have loopEnd = lastSample" - sampleIndex := (scaledIndex := scaledIndex - scaledLoopLength) // LoopIndexScaleFactor]. - (nextSampleIndex := sampleIndex + 1) > lastSample ifTrue: [ - sampleIndex > lastSample ifTrue: [count := 0. ^ nil]. "done!!" - scaledLoopLength = 0 - ifTrue: [nextSampleIndex := sampleIndex] - ifFalse: [nextSampleIndex := ((scaledIndex - scaledLoopLength) // LoopIndexScaleFactor) + 1]]. - - m := scaledIndex bitAnd: LoopIndexFractionMask. - rightVal := leftVal := - (((leftSamples at: sampleIndex) * (LoopIndexScaleFactor - m)) + - ((leftSamples at: nextSampleIndex) * m)) // LoopIndexScaleFactor. - isInStereo ifTrue: [ - rightVal := - (((rightSamples at: sampleIndex) * (LoopIndexScaleFactor - m)) + - ((rightSamples at: nextSampleIndex) * m)) // LoopIndexScaleFactor]. - - leftVol > 0 ifTrue: [ - s := (aSoundBuffer at: i) + ((compositeLeftVol * leftVal) // ScaleFactor). - s > 32767 ifTrue: [s := 32767]. "clipping!!" - s < -32767 ifTrue: [s := -32767]. "clipping!!" - aSoundBuffer at: i put: s]. - i := i + 1. - rightVol > 0 ifTrue: [ - s := (aSoundBuffer at: i) + ((compositeRightVol * rightVal) // ScaleFactor). - s > 32767 ifTrue: [s := 32767]. "clipping!!" - s < -32767 ifTrue: [s := -32767]. "clipping!!" - aSoundBuffer at: i put: s]. - i := i + 1. - - scaledVolIncr ~= 0 ifTrue: [ "update volume envelope if it is changing" - scaledVol := scaledVol + scaledVolIncr. - ((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or: - [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]]) - ifTrue: [ "reached the limit; stop incrementing" - scaledVol := scaledVolLimit. - scaledVolIncr := 0]. - compositeLeftVol := (leftVol * scaledVol) // ScaleFactor. - compositeRightVol := (rightVol * scaledVol) // ScaleFactor]]. - - count := count - n. - ! Item was removed: - ----- Method: LoopedSampledSound>>normalizedResultsFromFFT: (in category 'private') ----- - normalizedResultsFromFFT: fft - "Answer an array whose size is half of the FFT window size containing power in each frequency band, normalized to the average power over the entire FFT. A value of 10.0 in this array thus means that the power at the corresponding frequences is ten times the average power across the entire FFT." - - | r avg | - r := (1 to: fft realData size // 2) collect: - [:i | ((fft realData at: i) squared + (fft imagData at: i) squared) sqrt]. - avg := r sum / r size. - ^ r collect: [:v | v / avg]. - ! Item was removed: - ----- Method: LoopedSampledSound>>objectForDataStream: (in category 'disk i/o') ----- - objectForDataStream: refStrm - "Answer an object to store on a data stream, a copy of myself whose SampleBuffers have been converted into ByteArrays." - - refStrm replace: leftSamples with: leftSamples asByteArray. - refStrm replace: rightSamples with: rightSamples asByteArray. - "substitution will be made in DataStream nextPut:" - ^ self - ! Item was removed: - ----- Method: LoopedSampledSound>>originalSamplingRate (in category 'accessing') ----- - originalSamplingRate - - ^ originalSamplingRate - ! Item was removed: - ----- Method: LoopedSampledSound>>perceivedPitch (in category 'accessing') ----- - perceivedPitch - - ^ perceivedPitch - ! Item was removed: - ----- Method: LoopedSampledSound>>pitch (in category 'accessing') ----- - pitch - - ^ (scaledIndexIncr asFloat * perceivedPitch * self samplingRate asFloat) / - (originalSamplingRate * FloatLoopIndexScaleFactor) - ! Item was removed: - ----- Method: LoopedSampledSound>>pitch: (in category 'accessing') ----- - pitch: p - - scaledIndexIncr := - ((p asFloat * originalSamplingRate * FloatLoopIndexScaleFactor) / - (perceivedPitch * self samplingRate asFloat)) asInteger. - - sampleCountForRelease > 0 - ifTrue: [releaseCount := (sampleCountForRelease * LoopIndexScaleFactor) // scaledIndexIncr] - ifFalse: [releaseCount := 0]. - ! Item was removed: - ----- Method: LoopedSampledSound>>reset (in category 'sound generation') ----- - reset - - super reset. - count := initialCount. - scaledIndex := firstSample * LoopIndexScaleFactor. - ! Item was removed: - ----- Method: LoopedSampledSound>>rightSamples (in category 'accessing') ----- - rightSamples - - ^ rightSamples - ! Item was removed: - ----- Method: LoopedSampledSound>>rightSamples: (in category 'accessing') ----- - rightSamples: aSampleBuffer - - rightSamples := aSampleBuffer. - ! Item was removed: - ----- Method: LoopedSampledSound>>samples (in category 'accessing') ----- - samples - "For compatibility with SampledSound. Just return my left channel (which is the only channel if I am mono)." - - ^ leftSamples - ! Item was removed: - ----- Method: LoopedSampledSound>>samples:loopEnd:loopLength:pitch:samplingRate: (in category 'initialization') ----- - samples: aSoundBuffer loopEnd: loopEndIndex loopLength: loopSampleCount pitch: perceivedPitchInHz samplingRate: samplingRateInHz - "Make this sound use the given samples array with a loop of the given length starting at the given index. The loop length may have a fractional part; this is necessary to achieve pitch accuracy for short loops." - - | loopStartIndex | - super initialize. - loopStartIndex := (loopEndIndex - loopSampleCount) truncated + 1. - ((1 <= loopStartIndex) and: - [loopStartIndex < loopEndIndex and: - [loopEndIndex <= aSoundBuffer size]]) - ifFalse: [self error: 'bad loop parameters']. - - leftSamples := rightSamples := aSoundBuffer. - originalSamplingRate := samplingRateInHz asFloat. - perceivedPitch := perceivedPitchInHz asFloat. - gain := 1.0. - firstSample := 1. - lastSample := leftSamples size. - lastSample >= (SmallInteger maxVal // LoopIndexScaleFactor) ifTrue: [ - self error: 'cannot handle more than ', - (SmallInteger maxVal // LoopIndexScaleFactor) printString, ' samples']. - loopEnd := loopEndIndex. - scaledLoopLength := (loopSampleCount * LoopIndexScaleFactor) asInteger. - scaledIndexIncr := (samplingRateInHz * LoopIndexScaleFactor) // self samplingRate. - self computeSampleCountForRelease. - ! Item was removed: - ----- Method: LoopedSampledSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - "Answer the number of samples remaining until the end of this sound." - - ^ count - ! Item was removed: - ----- Method: LoopedSampledSound>>setPitch:dur:loudness: (in category 'initialization') ----- - setPitch: pitchNameOrNumber dur: d loudness: vol - "(LoopedSampledSound pitch: 440.0 dur: 2.5 loudness: 0.4) play" - - super setPitch: pitchNameOrNumber dur: d loudness: vol. - self pitch: (self nameOrNumberToPitch: pitchNameOrNumber). - self reset. - ! Item was removed: - ----- Method: LoopedSampledSound>>stopAfterMSecs: (in category 'sound generation') ----- - stopAfterMSecs: mSecs - "Terminate this sound this note after the given number of milliseconds." - - count := (mSecs * self samplingRate) // 1000. - ! Item was removed: - ----- Method: LoopedSampledSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- - storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream - "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files)." - - | reverseBytes | - (self isStereo or: [self samplingRate ~= originalSamplingRate]) ifTrue: [ - ^ super storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream]. - - "optimization: if I'm not stereo and sampling rates match, just store my buffer" - reverseBytes := bigEndianFlag ~= Smalltalk isBigEndian. - reverseBytes ifTrue: [leftSamples reverseEndianness]. - (aBinaryStream isKindOf: StandardFileStream) - ifTrue: [ "optimization for files: write sound buffer directly to file" - aBinaryStream next: (leftSamples size // 2) putAll: leftSamples startingAt: 1] "size in words" - ifFalse: [ "for non-file streams:" - 1 to: leftSamples monoSampleCount do: [:i | aBinaryStream int16: (leftSamples at: i)]]. - reverseBytes ifTrue: [leftSamples reverseEndianness]. "restore to original endianness" - ! Item was removed: - ----- Method: LoopedSampledSound>>unloopedSamples:pitch:samplingRate: (in category 'initialization') ----- - unloopedSamples: aSoundBuffer pitch: perceivedPitchInHz samplingRate: samplingRateInHz - "Make this sound play the given samples unlooped. The samples have the given perceived pitch when played at the given sampling rate. By convention, unpitched sounds such as percussion sounds should specify a pitch of nil or 100 Hz." - - super initialize. - leftSamples := rightSamples := aSoundBuffer. - originalSamplingRate := samplingRateInHz asFloat. - perceivedPitchInHz - ifNil: [perceivedPitch := 100.0] - ifNotNil: [perceivedPitch := perceivedPitchInHz asFloat]. - gain := 1.0. - firstSample := 1. - lastSample := leftSamples size. - lastSample >= (SmallInteger maxVal // LoopIndexScaleFactor) ifTrue: [ - self error: 'cannot handle more than ', - (SmallInteger maxVal // LoopIndexScaleFactor) printString, ' samples']. - loopEnd := leftSamples size. - scaledLoopLength := 0. "zero length means unlooped" - scaledIndexIncr := (samplingRateInHz * LoopIndexScaleFactor) // self samplingRate. - self computeSampleCountForRelease. - ! Item was removed: - Object subclass: #MIDIFileReader - instanceVariableNames: 'stream fileType trackCount ticksPerQuarter tracks trackInfo tempoMap strings track trackStream activeEvents maxNoteTicks' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !MIDIFileReader commentStamp: '<historical>' prior: 0! - A reader for Standard 1.0 format MIDI files. - MIDI File Types: - type 0 -- one multi-channel track - type 1 -- one or more simultaneous tracks - type 2 -- a number on independent single-track patterns - - Instance variables: - stream source of MIDI data - fileType MIDI file type - trackCount number of tracks in file - ticksPerQuarter number of ticks per quarter note for all tracks in this file - tracks collects track data for non-empty tracks - strings collects all strings in the MIDI file - tempoMap nil or a MIDITrack consisting only of tempo change events - trackStream stream on buffer containing track chunk - track track being read - activeEvents notes that have been turned on but not off - ! Item was removed: - ----- Method: MIDIFileReader class>>scoreFromFileNamed: (in category 'reading') ----- - scoreFromFileNamed: fileName - - | f | - f := (StandardFileStream readOnlyFileNamed: fileName) binary. - ^[(self new readMIDIFrom: f) asScore] - ensure: [f close]! Item was removed: - ----- Method: MIDIFileReader class>>scoreFromStream: (in category 'reading') ----- - scoreFromStream: binaryStream - - | score | - score := (self new readMIDIFrom: binaryStream) asScore. - ^ score - ! Item was removed: - ----- Method: MIDIFileReader class>>scoreFromURL: (in category 'reading') ----- - scoreFromURL: urlString - - | data | - data := HTTPSocket httpGet: urlString accept: 'audio/midi'. - data binary. - ^ (self new readMIDIFrom: data) asScore. - ! Item was removed: - ----- Method: MIDIFileReader class>>standardMIDIInstrumentNames (in category 'instruments') ----- - standardMIDIInstrumentNames - "Answer an array of Standard MIDI instrument names." - - ^ #( - 'Grand Piano' - 'Bright Piano' - 'Electric Grand Piano' - 'Honky-tonk Piano' - 'Electric Piano 1' - 'Electric Piano 2' - 'Harpsichord' - 'Clavichord' - 'Celesta' - 'Glockenspiel' - 'Music Box' - 'Vibraphone' - 'Marimba' - 'Xylophone' - 'Tubular Bells' - 'Duclimer' - 'Drawbar Organ' - 'Percussive Organ' - 'Rock Organ' - 'Church Organ' - 'Reed Organ' - 'Accordion' - 'Harmonica' - 'Tango Accordion' - 'Nylon Guitar' - 'Steel Guitar' - 'Electric Guitar 1' - 'Electric Guitar 2' - 'Electric Guitar 3' - 'Overdrive Guitar' - 'Distorted Guitar' - 'Guitar Harmonics' - 'Acoustic Bass' - 'Electric Bass 1' - 'Electric Bass 2' - 'Fretless Bass' - 'Slap Bass 1' - 'Slap Bass 2' - 'Synth Bass 1' - 'Synth Bass 2' - 'Violin' - 'Viola' - 'Cello' - 'Contrabass' - 'Tremolo Strings' - 'Pizzicato Strings' - 'Orchestral Harp' - 'Timpani' - 'String Ensemble 1' - 'String Ensemble 2' - 'Synth Strings 1' - 'Synth Strings 2' - 'Choir Ahhs' - 'Choir Oohs' - 'Synth Voice' - 'Orchestra Hit' - 'Trumpet' - 'Trombone' - 'Tuba' - 'Muted Trumpet' - 'French Horn' - 'Brass Section' - 'Synth Brass 1' - 'Synth Brass 2' - 'Soprano Sax' - 'Alto Sax' - 'Tenor Sax' - 'Baritone Sax' - 'Oboe' - 'English Horn' - 'Bassoon' - 'Clarinet' - 'Piccolo' - 'Flute' - 'Recorder' - 'Pan Flute' - 'Blown Bottle' - 'Shakuhachi' - 'Whistle' - 'Ocarina' - 'Lead 1 (square)' - 'Lead 2 (sawtooth)' - 'Lead 3 (calliope)' - 'Lead 4 (chiff)' - 'Lead 5 (charang)' - 'Lead 6 (voice)' - 'Lead 7 (fifths)' - 'Lead 8 (bass+lead)' - 'Pad 1 (new age)' - 'Pad 2 (warm)' - 'Pad 3 (polysynth)' - 'Pad 4 (choir)' - 'Pad 5 (bowed)' - 'Pad 6 (metallic)' - 'Pad 7 (halo)' - 'Pad 8 (sweep)' - 'FX 1 (rain)' - 'FX 2 (soundtrack)' - 'FX 3 (crystals)' - 'FX 4 (atmosphere)' - 'FX 5 (brightness)' - 'FX 6 (goblins)' - 'FX 7 (echoes)' - 'FX 8 (sci-fi)' - 'Sitar' - 'Banjo' - 'Shamisen' - 'Koto' - 'Kalimba' - 'Bagpipe' - 'Fiddle' - 'Shanai' - 'Tinkle Bell' - 'Agogo' - 'Steel Drum' - 'Woodblock' - 'Taiko Drum' - 'Melodic Tom' - 'Synth Drum' - 'Reverse Cymbal' - 'Guitar Fret Noise' - 'Breath Noise' - 'Seashore' - 'Bird Tweet' - 'Telephone Ring' - 'Helicopter' - 'Applause' - 'Gunshot') - ! Item was removed: - ----- Method: MIDIFileReader>>asScore (in category 'chunk reading') ----- - asScore - - ^ MIDIScore new - tracks: tracks trackInfo: trackInfo; - tempoMap: tempoMap; - ticksPerQuarterNote: ticksPerQuarter; - source: stream localName - ! Item was removed: - ----- Method: MIDIFileReader>>endAllNotesAt: (in category 'track reading') ----- - endAllNotesAt: endTicks - "End of score; end any notes still sounding." - "Details: Some MIDI files have missing note-off events, resulting in very long notes. Truncate any such notes encountered." - - - activeEvents do: [:e | | dur | - dur := endTicks - e time. - dur > maxNoteTicks ifTrue: [dur := ticksPerQuarter]. "truncate long note" - e duration: dur]. - activeEvents := activeEvents species new. - ! Item was removed: - ----- Method: MIDIFileReader>>endNote:chan:at: (in category 'track reading') ----- - endNote: midiKey chan: channel at: endTicks - - | evt | - evt := activeEvents - detect: [:e | (e midiKey = midiKey) and: [e channel = channel]] - ifNone: [^ self]. - evt duration: (endTicks - evt time). - activeEvents remove: evt ifAbsent: []. - ! Item was removed: - ----- Method: MIDIFileReader>>guessMissingInstrumentNames (in category 'private') ----- - guessMissingInstrumentNames - "Attempt to guess missing instrument names from the first program change in that track." - - | progChange instrIndex instrName | - 1 to: tracks size do: [:i | - (trackInfo at: i) isEmpty ifTrue: [ - progChange := (tracks at: i) detect: [:e | e isProgramChange] ifNone: [nil]. - progChange ifNotNil: [ - instrIndex := progChange program + 1. - instrName := self class standardMIDIInstrumentNames at: instrIndex. - trackInfo at: i put: instrName]]]. - ! Item was removed: - ----- Method: MIDIFileReader>>isTempoTrack: (in category 'track reading') ----- - isTempoTrack: anEventList - "Return true if the given event list is non-empty and contains only tempo change events." - - anEventList isEmpty ifTrue: [^ false]. - anEventList do: [:evt | evt isTempoEvent ifFalse: [^ false]]. - ^ true - ! Item was removed: - ----- Method: MIDIFileReader>>metaEventAt: (in category 'track reading') ----- - metaEventAt: ticks - "Read a meta event. Event types appear roughly in order of expected frequency." - - | type length tempo | - type := trackStream next. - length := self readVarLengthIntFrom: trackStream. - - type = 16r51 ifTrue: [ "tempo" - tempo := 0. - length timesRepeat: [tempo := (tempo bitShift: 8) + trackStream next]. - track add: (TempoEvent new tempo: tempo; time: ticks). - ^ self]. - - type = 16r2F ifTrue: [ "end of track" - length = 0 ifFalse: [self error: 'length of end-of-track chunk should be zero']. - self endAllNotesAt: ticks. - trackStream skip: length. - ^ self]. - - type = 16r58 ifTrue: [ "time signature" - length = 4 ifFalse: [self error: 'length of time signature chunk should be four']. - trackStream skip: length. - ^ self]. - - type = 16r59 ifTrue: [ "key signature" - length = 2 ifFalse: [self error: 'length of key signature chunk should be two']. - trackStream skip: length. - ^ self]. - - ((type >= 1) and: [type <= 7]) ifTrue: [ "string" - strings add: (trackStream next: length) asString. - ^ self]. - - ( type = 16r21 or: "mystery; found in MIDI files but not in MIDI File 1.0 Spec" - [(type = 16r7F) or: "sequencer specific meta event" - [(type = 16r00) or: "sequence number" - [(type = 16r20)]]]) "MIDI channel prefix" - ifTrue: [ - trackStream skip: length. - ^ self]. - - type = 16r54 ifTrue: [ - "SMPTE offset" - self report: 'Ignoring SMPTE offset'. - trackStream skip: length. - ^ self]. - - "skip unrecognized meta event" - self report: - 'skipping unrecognized meta event: ', (type printStringBase: 16), - ' (', length printString, ' bytes)'. - trackStream skip: length. - ! Item was removed: - ----- Method: MIDIFileReader>>next16BitWord (in category 'private') ----- - next16BitWord - "Read a 16-bit positive integer from the input stream, most significant byte first." - "Assume: Stream has at least two bytes left." - - | n | - n := stream next. - ^ (n bitShift: 8) + stream next - ! Item was removed: - ----- Method: MIDIFileReader>>next32BitWord: (in category 'private') ----- - next32BitWord: msbFirst - "Read a 32-bit positive integer from the input stream." - "Assume: Stream has at least four bytes left." - - | n | - n := stream next: 4. - ^msbFirst - ifTrue:[((n at: 1) bitShift: 24) + ((n at: 2) bitShift: 16) + ((n at: 3) bitShift: 8) + (n at: 4)] - ifFalse:[((n at: 4) bitShift: 24) + ((n at: 3) bitShift: 16) + ((n at: 2) bitShift: 8) + (n at: 1)] - ! Item was removed: - ----- Method: MIDIFileReader>>readChunkSize (in category 'private') ----- - readChunkSize - "Read a 32-bit positive integer from the next 4 bytes, most significant byte first." - "Assume: Stream has at least four bytes left." - - | n | - n := 0. - 1 to: 4 do: [:ignore | n := (n bitShift: 8) + stream next]. - ^ n - ! Item was removed: - ----- Method: MIDIFileReader>>readChunkType (in category 'private') ----- - readChunkType - "Read a chunk ID string from the next 4 bytes." - "Assume: Stream has at least four bytes left." - - | s | - s := String new: 4. - 1 to: 4 do: [:i | s at: i put: (stream next) asCharacter]. - ^ s - ! Item was removed: - ----- Method: MIDIFileReader>>readHeaderChunk (in category 'chunk reading') ----- - readHeaderChunk - - | chunkType chunkSize division | - chunkType := self readChunkType. - chunkType = 'RIFF' ifTrue:[chunkType := self riffSkipToMidiChunk]. - chunkType = 'MThd' ifFalse: [self scanForMIDIHeader]. - chunkSize := self readChunkSize. - fileType := self next16BitWord. - trackCount := self next16BitWord. - division := self next16BitWord. - (division anyMask: 16r8000) - ifTrue: [self error: 'SMPTE time formats are not yet supported'] - ifFalse: [ticksPerQuarter := division]. - maxNoteTicks := 12 * 4 * ticksPerQuarter. - "longest acceptable note; used to detect stuck notes" - - "sanity checks" - ((chunkSize < 6) or: [chunkSize > 100]) - ifTrue: [self error: 'unexpected MIDI header size ', chunkSize printString]. - (#(0 1 2) includes: fileType) - ifFalse: [self error: 'unknown MIDI file type ', fileType printString]. - - Transcript - show: 'Reading Type ', fileType printString, ' MIDI File ('; - show: trackCount printString, ' tracks, '; - show: ticksPerQuarter printString, ' ticks per quarter note)'; - cr. - ! Item was removed: - ----- Method: MIDIFileReader>>readMIDIFrom: (in category 'chunk reading') ----- - readMIDIFrom: aBinaryStream - "Read one or more MIDI tracks from the given binary stream." - - stream := aBinaryStream. - tracks := OrderedCollection new. - trackInfo := OrderedCollection new. - self readHeaderChunk. - trackCount timesRepeat: [self readTrackChunk]. - stream atEnd ifFalse: [self report: 'data beyond final track']. - fileType = 0 ifTrue: [self splitIntoTracks]. - self guessMissingInstrumentNames. - ! Item was removed: - ----- Method: MIDIFileReader>>readTrackChunk (in category 'chunk reading') ----- - readTrackChunk - - | chunkType chunkSize | - chunkType := self readChunkType. - [chunkType = 'MTrk'] whileFalse: [ - self report: 'skipping unexpected chunk type "', chunkType, '"'. - stream skip: (self readChunkSize). "skip it" - chunkType := (stream next: 4) asString]. - chunkSize := self readChunkSize. - chunkSize < 10000000 ifFalse: [ - self error: 'suspiciously large track chunk; this may not be MIDI file']. - - self readTrackContents: chunkSize. - ! Item was removed: - ----- Method: MIDIFileReader>>readTrackContents: (in category 'track reading') ----- - readTrackContents: byteCount - - | info | - strings := OrderedCollection new. - track := OrderedCollection new. - trackStream := ReadStream on: (stream next: byteCount). - activeEvents := OrderedCollection new. - self readTrackEvents. - (tracks isEmpty and: [self isTempoTrack: track]) - ifTrue: [tempoMap := track asArray] - ifFalse: [ - "Note: Tracks without note events are currently not saved to - eliminate clutter in the score player. In control applications, - this can be easily changed by modifying the following test." - (self trackContainsNotes: track) ifTrue: [ - tracks add: track asArray. - info := WriteStream on: (String new: 100). - strings do: [:s | info nextPutAll: s; cr]. - trackInfo add: info contents]]. - strings := track := trackStream := activeEvents := nil. - ! Item was removed: - ----- Method: MIDIFileReader>>readTrackEvents (in category 'track reading') ----- - readTrackEvents - "Read the events of the current track." - - | cmd chan key vel ticks byte length evt | - cmd := #unknown. - chan := key := vel := 0. - ticks := 0. - [trackStream atEnd] whileFalse: [ - ticks := ticks + (self readVarLengthIntFrom: trackStream). - byte := trackStream next. - byte >= 16rF0 - ifTrue: [ "meta or system exclusive event" - byte = 16rFF ifTrue: [self metaEventAt: ticks]. - ((byte = 16rF0) or: [byte = 16rF7]) ifTrue: [ "system exclusive data" - length := self readVarLengthIntFrom: trackStream. - trackStream skip: length]. - cmd := #unknown] - ifFalse: [ "channel message event" - byte >= 16r80 - ifTrue: [ "new command" - cmd := byte bitAnd: 16rF0. - chan := byte bitAnd: 16r0F. - key := trackStream next] - ifFalse: [ "use running status" - cmd == #unknown - ifTrue: [self error: 'undefined running status; bad MIDI file?']. - key := byte]. - - ((cmd = 16rC0) or: [cmd = 16rD0]) ifFalse: [ - "all but program change and channel pressure have two data bytes" - vel := trackStream next]. - - cmd = 16r80 ifTrue: [ "note off" - self endNote: key chan: chan at: ticks]. - - cmd = 16r90 ifTrue: [ "note on" - vel = 0 - ifTrue: [self endNote: key chan: chan at: ticks] - ifFalse: [self startNote: key vel: vel chan: chan at: ticks]]. - - "cmd = 16A0 -- polyphonic key pressure; skip" - - cmd = 16rB0 ifTrue: [ - evt := ControlChangeEvent new control: key value: vel channel: chan. - evt time: ticks. - track add: evt]. - - cmd = 16rC0 ifTrue: [ - evt := ProgramChangeEvent new program: key channel: chan. - evt time: ticks. - track add: evt]. - - "cmd = 16D0 -- channel aftertouch pressure; skip" - - cmd = 16rE0 ifTrue: [ - evt := PitchBendEvent new bend: key + (vel bitShift: 7) channel: chan. - evt time: ticks. - track add: evt] - ]]. - ! Item was removed: - ----- Method: MIDIFileReader>>readVarLengthIntFrom: (in category 'private') ----- - readVarLengthIntFrom: aBinaryStream - "Read a one to four byte positive integer from the given stream, most significant byte first. Use only the lowest seven bits of each byte. The highest bit of a byte is set for all bytes except the last." - - | n byte | - n := 0. - 1 to: 4 do: [:ignore | - byte := aBinaryStream next. - byte < 128 ifTrue: [ - n = 0 - ifTrue: [^ byte] "optimization for one-byte lengths" - ifFalse: [^ (n bitShift: 7) + byte]]. - n := (n bitShift: 7) + (byte bitAnd: 16r7F)]. - - self error: 'variable length quantity must not exceed four bytes'. - ! Item was removed: - ----- Method: MIDIFileReader>>report: (in category 'private') ----- - report: aString - - Transcript show: aString; cr. - ! Item was removed: - ----- Method: MIDIFileReader>>riffSkipToMidiChunk (in category 'private') ----- - riffSkipToMidiChunk - "This file is a RIFF file which may (or may not) contain a MIDI chunk. Thanks to Andreas Raab for this code." - - | dwLength fourcc | - "Read length of all data" - dwLength := self next32BitWord: false. - "Get RIFF contents type " - fourcc := self readChunkType. - fourcc = 'RMID' ifFalse:[^fourcc]. "We can only read RMID files here" - "Search for data" - [[fourcc := self readChunkType. - dwLength := self next32BitWord: false. - fourcc = 'data'] whileFalse:[ - "Skip chunk - rounded to word boundary" - stream skip: (dwLength + 1 bitAnd: 16rFFFFFFFE). - stream atEnd ifTrue:[^'']]. - "Data chunk is raw - look into if it contains MIDI data and skip if not" - fourcc := self readChunkType. - fourcc = 'MThd'] whileFalse:[ - "Skip data (chunk - 4bytes) rounded to word boundary" - stream skip: (dwLength - 3 bitAnd: 16rFFFFFFFE)]. - ^fourcc! Item was removed: - ----- Method: MIDIFileReader>>scanForMIDIHeader (in category 'private') ----- - scanForMIDIHeader - "Scan the first part of this file in search of the MIDI header string 'MThd'. Report an error if it is not found. Otherwise, leave the input stream positioned to the first byte after this string." - - | asciiM p lastSearchPosition byte restOfHeader | - asciiM := $M asciiValue. - stream skip: -3. - p := stream position. - lastSearchPosition := p + 10000. "search only the first 10000 bytes of the file" - [p < lastSearchPosition and: [stream atEnd not]] whileTrue: [ - [(byte := stream next) ~= asciiM and: [byte ~~ nil]] whileTrue. "find the next 'M' or file end" - restOfHeader := (stream next: 3) asString. - restOfHeader = 'Thd' - ifTrue: [^ self] - ifFalse: [restOfHeader size = 3 ifTrue: [stream skip: -3]]. - p := stream position]. - - self error: 'MIDI header chunk not found'. - ! Item was removed: - ----- Method: MIDIFileReader>>splitIntoTracks (in category 'private') ----- - splitIntoTracks - "Split a type zero MIDI file into separate tracks by channel number." - - | newTempoMap newTracks | - tracks size = 1 ifFalse: [self error: 'expected exactly one track in type 0 file']. - tempoMap ifNotNil: [self error: 'did not expect a tempo map in type 0 file']. - newTempoMap := OrderedCollection new. - newTracks := (1 to: 16) collect: [:i | OrderedCollection new]. - tracks first do: [:e | - e isTempoEvent - ifTrue: [newTempoMap addLast: e] - ifFalse: [(newTracks at: e channel + 1) addLast: e]]. - newTempoMap size > 0 ifTrue: [tempoMap := newTempoMap asArray]. - newTracks := newTracks select: [:t | self trackContainsNotes: t]. - tracks := newTracks collect: [:t | t asArray]. - trackInfo := trackInfo, ((2 to: tracks size) collect: [:i | '']). - ! Item was removed: - ----- Method: MIDIFileReader>>startNote:vel:chan:at: (in category 'track reading') ----- - startNote: midiKey vel: vel chan: chan at: startTicks - "Record the beginning of a note." - "Details: Some MIDI scores have missing note-off events, causing a note-on to be received for a (key, channel) that is already sounding. If the previous note is suspiciously long, truncate it." - - | noteOnEvent newActiveEvents | - newActiveEvents := nil. - activeEvents do: [:e | | dur | - ((e midiKey = midiKey) and: [e channel = chan]) ifTrue: [ - "turn off key already sounding" - dur := startTicks - e time. - dur > maxNoteTicks ifTrue: [dur := ticksPerQuarter]. "truncate" - e duration: dur. - newActiveEvents ifNil: [newActiveEvents := activeEvents copy]. - newActiveEvents remove: e ifAbsent: []]]. - newActiveEvents ifNotNil: [activeEvents := newActiveEvents]. - - noteOnEvent := NoteEvent new key: midiKey velocity: vel channel: chan. - noteOnEvent time: startTicks. - track add: noteOnEvent. - activeEvents add: noteOnEvent. - ! Item was removed: - ----- Method: MIDIFileReader>>trackContainsNotes: (in category 'track reading') ----- - trackContainsNotes: eventList - "Answer true if the given track contains at least one note event." - - eventList do: [:e | e isNoteEvent ifTrue: [^ true]]. - ^ false - ! Item was removed: - Object subclass: #MIDIInputParser - instanceVariableNames: 'cmdActionTable midiPort received rawDataBuffer sysExBuffer ignoreSysEx startTime timeNow state lastSelector lastCmdByte argByte1 argByte2' - classVariableNames: 'DefaultMidiTable' - poolDictionaries: '' - category: 'Sound-Scores'! - - !MIDIInputParser commentStamp: '<historical>' prior: 0! - I am a parser for a MIDI data stream. I support: - - real-time MIDI recording, - overdubbing (recording while playing), - monitoring incoming MIDI, and - interactive MIDI performances. - - Note: MIDI controllers such as pitch benders and breath controllers generate large volumes of data which consume processor time. In cases where this information is not of interest to the program using it, it is best to filter it out as soon as possible. I support various options for doing this filtering, including filtering by MIDI channel and/or by command type. - ! Item was removed: - ----- Method: MIDIInputParser class>>initialize (in category 'class initialization') ----- - initialize - "Build the default MIDI command-byte action table. This table maps MIDI command bytes to the action to be performed when that is received. Note that MIDI data bytes (bytes whose value is < 128) are never used to index into this table." - "MIDIInputParser initialize" - - DefaultMidiTable := Array new: 255 withAll: #undefined:. - 128 to: 143 do: [:i | DefaultMidiTable at: i put: #recordTwo:]. "key off" - 144 to: 159 do: [:i | DefaultMidiTable at: i put: #recordTwo:]. "key on" - 160 to: 175 do: [:i | DefaultMidiTable at: i put: #recordTwo:]. "polyphonic after-touch" - 176 to: 191 do: [:i | DefaultMidiTable at: i put: #recordTwo:]. "control change" - 192 to: 207 do: [:i | DefaultMidiTable at: i put: #recordOne:]. "program change" - 208 to: 223 do: [:i | DefaultMidiTable at: i put: #recordOne:]. "channel after-touch" - 224 to: 239 do: [:i | DefaultMidiTable at: i put: #recordTwo:]. "pitch bend" - - DefaultMidiTable at: 240 put: #startSysExclusive:. "start a system exclusive block" - DefaultMidiTable at: 241 put: #recordOne:. "MIDI time code quarter frame" - DefaultMidiTable at: 242 put: #recordTwo:. "song position select" - DefaultMidiTable at: 243 put: #recordOne:. "song select" - DefaultMidiTable at: 244 put: #undefined:. - DefaultMidiTable at: 245 put: #undefined:. - DefaultMidiTable at: 246 put: #recordZero:. "tune request" - DefaultMidiTable at: 247 put: #endSysExclusive:. "end a system exclusive block" - DefaultMidiTable at: 248 put: #recordZero:. "timing clock" - DefaultMidiTable at: 249 put: #undefined:. - DefaultMidiTable at: 250 put: #recordZero:. "start" - DefaultMidiTable at: 251 put: #recordZero:. "continue" - DefaultMidiTable at: 252 put: #recordZero:. "stop/Clock" - DefaultMidiTable at: 253 put: #undefined:. - DefaultMidiTable at: 254 put: #recordZero:. "active sensing" - DefaultMidiTable at: 255 put: #recordZero:. "system reset" - ! Item was removed: - ----- Method: MIDIInputParser class>>on: (in category 'instance creation') ----- - on: aSimpleMIDIPort - "Answer a new MIDI parser on the given port." - - ^ super new setMIDIPort: aSimpleMIDIPort - ! Item was removed: - ----- Method: MIDIInputParser>>clearBuffers (in category 'recording') ----- - clearBuffers - "Clear the MIDI record buffers. This should be called at the start of recording or real-time MIDI processing." - - received := received species new: 5000. - rawDataBuffer := ByteArray new: 1000. - sysExBuffer := WriteStream on: (ByteArray new: 100). - midiPort ifNotNil: [midiPort ensureOpen; flushInput]. - startTime := Time millisecondClockValue. - state := #idle. - ! Item was removed: - ----- Method: MIDIInputParser>>endSysExclusive: (in category 'private-state machine') ----- - endSysExclusive: cmdByte - "Error!! Received 'end system exclusive' command when not receiving system exclusive data." - - self error: 'unexpected ''End of System Exclusive'' command'. - ! Item was removed: - ----- Method: MIDIInputParser>>ignoreChannel: (in category 'midi filtering') ----- - ignoreChannel: channel - "Don't record any events arriving on the given MIDI channel (in the range 1-16)." - - ((channel isInteger not) | (channel < 1) | (channel > 16)) - ifTrue: [^ self error: 'bad MIDI channel number', channel printString]. - - "two-arg channel messages" - #(128 144 160 176 224) do: [:i | cmdActionTable at: (i bitOr: channel - 1) put: #ignoreTwo:]. - - "one-arg channel messages" - #(192 208) do: [:i | cmdActionTable at: (i bitOr: channel - 1) put: #ignoreOne:]. - ! Item was removed: - ----- Method: MIDIInputParser>>ignoreCommand: (in category 'midi filtering') ----- - ignoreCommand: midiCmd - "Don't record the given MIDI command on any channel." - - | cmd sel | - ((midiCmd isInteger not) | (midiCmd < 128) | (midiCmd > 255)) - ifTrue: [^ self error: 'bad MIDI command']. - - midiCmd < 240 ifTrue: [ "channel commands; ignore on all channels" - cmd := midiCmd bitAnd: 2r11110000. - sel := (#(128 144 160 176 224) includes: cmd) - ifTrue: [#ignoreTwo:] - ifFalse: [#ignoreOne:]. - 1 to: 16 do: [:ch | cmdActionTable at: (cmd bitOr: ch - 1) put: sel]. - ^ self]. - - (#(240 241 244 245 247 249 253) includes: midiCmd) ifTrue: [ - ^ self error: 'You can''t ignore the undefined MIDI command: ', midiCmd printString]. - - midiCmd = 242 ifTrue: [ "two-arg command" - cmdActionTable at: midiCmd put: #ignoreTwo:. - ^ self]. - - midiCmd = 243 ifTrue: [ "one-arg command" - cmdActionTable at: midiCmd put: #ignoreOne:. - ^ self]. - - (#(246 248 250 251 252 254 255) includes: midiCmd) ifTrue: [ "zero-arg command" - cmdActionTable at: midiCmd put: #ignore. - ^ self]. - - "we should not get here" - self error: 'implementation error'. - ! Item was removed: - ----- Method: MIDIInputParser>>ignoreOne: (in category 'private-state machine') ----- - ignoreOne: cmdByte - "Ignore a one argument command." - - lastCmdByte := cmdByte. - lastSelector := #ignoreOne:. - state := #ignore1. - ! Item was removed: - ----- Method: MIDIInputParser>>ignoreSysEx: (in category 'midi filtering') ----- - ignoreSysEx: aBoolean - "If the argument is true, then ignore incoming system exclusive message." - - ignoreSysEx := aBoolean. - ! Item was removed: - ----- Method: MIDIInputParser>>ignoreTuneAndRealTimeCommands (in category 'midi filtering') ----- - ignoreTuneAndRealTimeCommands - "Ignore tuning requests and real-time commands." - - cmdActionTable at: 246 put: #ignoreZero:. "tune request" - cmdActionTable at: 248 put: #ignoreZero:. "timing clock" - cmdActionTable at: 250 put: #ignoreZero:. "start" - cmdActionTable at: 251 put: #ignoreZero:. "continue" - cmdActionTable at: 252 put: #ignoreZero:. "stop/Clock" - cmdActionTable at: 254 put: #ignoreZero:. "active sensing" - cmdActionTable at: 255 put: #ignoreZero:. "system reset" - ! Item was removed: - ----- Method: MIDIInputParser>>ignoreTwo: (in category 'private-state machine') ----- - ignoreTwo: cmdByte - "Ignore a two argument command." - - lastCmdByte := cmdByte. - lastSelector := #ignoreTwo:. - state := #ignore2. - ! Item was removed: - ----- Method: MIDIInputParser>>ignoreZero: (in category 'private-state machine') ----- - ignoreZero: cmdByte - "Ignore a zero argument command, such as tune request or a real-time message. Stay in the current and don't change active status. Note that real-time messages can arrive between data bytes without disruption." - - "do nothing" - ! Item was removed: - ----- Method: MIDIInputParser>>midiDo: (in category 'real-time processing') ----- - midiDo: aBlock - "Poll the incoming MIDI stream in real time and call the given block for each complete command that has been received. The block takes one argument, which is an array of the form (<time><cmd byte>[<arg1>[<arg2>]]). The number of arguments depends on the command byte. For system exclusive commands, the argument is a ByteArray containing the system exclusive message." - - self processMIDIData. - [received isEmpty] whileFalse: - [aBlock value: received removeFirst]. - ! Item was removed: - ----- Method: MIDIInputParser>>midiDoUntilMouseDown: (in category 'real-time processing') ----- - midiDoUntilMouseDown: midiActionBlock - "Process the incoming MIDI stream in real time by calling midiActionBlock for each MIDI event. This block takes three arguments: the MIDI command byte and two argument bytes. One or both argument bytes may be nil, depending on the MIDI command. If not nil, evaluatue idleBlock regularly whether MIDI data is available or not. Pressing any mouse button terminates the interaction." - - | time cmd arg1 arg2 | - self clearBuffers. - [Sensor anyButtonPressed] whileFalse: [ - self midiDo: [:item | - time := item at: 1. - cmd := item at: 2. - arg1 := arg2 := nil. - item size > 2 ifTrue: [ - arg1 := item at: 3. - item size > 3 ifTrue: [arg2 := item at: 4]]. - midiActionBlock value: cmd value: arg1 value: arg2]]. - ! Item was removed: - ----- Method: MIDIInputParser>>midiPort (in category 'accessing') ----- - midiPort - - ^ midiPort - ! Item was removed: - ----- Method: MIDIInputParser>>midiPort: (in category 'accessing') ----- - midiPort: aMIDIPort - "Use the given MIDI port." - - midiPort := aMIDIPort. - self clearBuffers. - ! Item was removed: - ----- Method: MIDIInputParser>>monitor (in category 'midi monitor') ----- - monitor - "Print MIDI messages to the transcript until any mouse button is pressed." - - self midiDoUntilMouseDown: [:cmd :arg1 :arg2 | - self printCmd: cmd with: arg1 with: arg2]. - ! Item was removed: - ----- Method: MIDIInputParser>>noFiltering (in category 'midi filtering') ----- - noFiltering - "Revert to accepting all MIDI commands on all channels. This undoes any earlier request to filter the incoming MIDI stream." - - cmdActionTable := DefaultMidiTable deepCopy. - ignoreSysEx := false. - ! Item was removed: - ----- Method: MIDIInputParser>>printCmd:with:with: (in category 'midi monitor') ----- - printCmd: cmdByte with: arg1 with: arg2 - "Print the given MIDI command." - - | cmd ch bend | - cmdByte < 240 - ifTrue: [ "channel message" - cmd := cmdByte bitAnd: 2r11110000. - ch := (cmdByte bitAnd: 2r00001111) + 1] - ifFalse: [cmd := cmdByte]. "system message" - - cmd = 128 ifTrue: [ - ^ Transcript show: ('key up ', arg1 printString, ' vel: ', arg2 printString, ' chan: ', ch printString); cr]. - cmd = 144 ifTrue: [ - ^ Transcript show: ('key down: ', arg1 printString, ' vel: ', arg2 printString, ' chan: ', ch printString); cr]. - cmd = 160 ifTrue: [ - ^ Transcript show: ('key pressure: ', arg1 printString, ' val: ', arg2 printString, ' chan: ', ch printString); cr]. - cmd = 176 ifTrue: [ - ^ Transcript show: ('CC', arg1 printString, ': val: ', arg2 printString, ' chan: ', ch printString); cr]. - cmd = 192 ifTrue: [ - ^ Transcript show: ('prog: ', (arg1 + 1) printString, ' chan: ', ch printString); cr]. - cmd = 208 ifTrue: [ - ^ Transcript show: ('channel pressure ', arg1 printString, ' chan: ', ch printString); cr]. - cmd = 224 ifTrue: [ - bend := ((arg2 bitShift: 7) + arg1) - 8192. - ^ Transcript show: ('bend: ', bend printString, ' chan: ', ch printString); cr]. - - cmd = 240 ifTrue: [ - ^ Transcript show: ('system exclusive: ', (arg1 at: 1) printString, ' (', arg1 size printString, ' bytes)'); cr]. - - Transcript show: 'cmd: ', cmd printString, ' arg1: ', arg1 printString, ' arg2: ', arg2 printString; cr. - ! Item was removed: - ----- Method: MIDIInputParser>>processByte: (in category 'private-state machine') ----- - processByte: aByte - "Process the given incoming MIDI byte and record completed commands." - "Details: Because this must be fast, it has been hand-tuned. Be careful!!" - - aByte > 247 ifTrue: [ "real-time message; can arrive at any time" - ^ self perform: (cmdActionTable at: aByte) with: aByte]. - - #idle = state ifTrue: [ - aByte >= 128 - ifTrue: [ "command byte in idle state: start new command" - ^ self perform: (cmdActionTable at: aByte) with: aByte] - ifFalse: [ "data byte in idle state: use running status if possible" - lastCmdByte ifNil: [^ self]. "running status unknown; skip byte" - "process this data as if it had the last command byte in front of it" - self perform: lastSelector with: lastCmdByte. - - "the previous line put us into a new state; we now 'fall through' - to process the data byte given this new state."]]. - - #ignore1 = state ifTrue: [^ state := #idle]. - #ignore2 = state ifTrue: [^ state := #ignore1]. - - #want1of2 = state ifTrue: [ - argByte1 := aByte. - ^ state := #want2of2]. - - #want2of2 = state ifTrue: [ - argByte2 := aByte. - received addLast: (Array with: timeNow with: lastCmdByte with: argByte1 with: argByte2). - ^ state := #idle]. - - #want1only = state ifTrue: [ - argByte1 := aByte. - received addLast: (Array with: timeNow with: lastCmdByte with: argByte1). - ^ state := #idle]. - - #sysExclusive = state ifTrue: [ - aByte < 128 ifTrue: [ - "record a system exclusive data byte" - ignoreSysEx ifFalse: [sysExBuffer nextPut: aByte]. - ^ self] - ifFalse: [ - aByte < 248 ifTrue: [ - "a system exclusive message is terminated by any non-real-time command byte" - ignoreSysEx ifFalse: [ - received addLast: (Array with: timeNow with: lastCmdByte with: sysExBuffer contents)]. - state := #idle. - aByte = 247 - ifTrue: [^ self] "endSysExclusive command, nothing left to do" - ifFalse: [^ self processByte: aByte]]]]. "no endSysExclusive; just start the next command" - ! Item was removed: - ----- Method: MIDIInputParser>>processMIDIData (in category 'recording') ----- - processMIDIData - "Process all MIDI data that has arrived since the last time this method was executed. This method should be called frequently to process, filter, and timestamp MIDI data as it arrives." - - | bytesRead | - [(bytesRead := midiPort readInto: rawDataBuffer) > 0] whileTrue: [ - timeNow := (midiPort bufferTimeStampFrom: rawDataBuffer) - startTime. - 5 to: bytesRead do: [:i | self processByte: (rawDataBuffer at: i)]]. - ! Item was removed: - ----- Method: MIDIInputParser>>received (in category 'recording') ----- - received - "Answer my current collection of all MIDI commands received. Items in this list have the form (<time><cmd byte>[<arg1>[<arg2>]]). Note that the real-time processing facility, midiDo:, removes items from this list as it processes them." - - ^ received - ! Item was removed: - ----- Method: MIDIInputParser>>recordOne: (in category 'private-state machine') ----- - recordOne: cmdByte - "Record a one argument command at the current time." - - lastCmdByte := cmdByte. - lastSelector := #recordOne:. - state := #want1only. - ! Item was removed: - ----- Method: MIDIInputParser>>recordOnlyChannels: (in category 'midi filtering') ----- - recordOnlyChannels: channelList - "Record only MIDI data arriving on the given list of channel numbers (in the range 1-16)." - - channelList do: [:ch | - ((ch isInteger not) | (ch < 1) | (ch > 16)) - ifTrue: [^ self error: 'bad Midi channel specification: ', ch printString]]. - - 1 to: 16 do: [:ch | (channelList includes: ch) ifFalse: [self ignoreChannel: ch]]. - ! Item was removed: - ----- Method: MIDIInputParser>>recordTwo: (in category 'private-state machine') ----- - recordTwo: cmdByte - "Record a two argument command at the current time." - - lastCmdByte := cmdByte. - lastSelector := #recordTwo:. - state := #want1of2. - ! Item was removed: - ----- Method: MIDIInputParser>>recordZero: (in category 'private-state machine') ----- - recordZero: cmdByte - "Record a zero-byte message, such as tune request or a real-time message. Don't change active status. Note that real-time messages can arrive between data bytes without disruption." - - received addLast: (Array with: timeNow with: cmdByte). - ! Item was removed: - ----- Method: MIDIInputParser>>setMIDIPort: (in category 'private-other') ----- - setMIDIPort: aMIDIPort - "Initialize this instance for recording from the given MIDI port. Tune and real-time commands are filtered out by default; the client can send noFiltering to receive these messages." - - midiPort := aMIDIPort. - received := OrderedCollection new. - self noFiltering. "initializes cmdActionTable" - self ignoreTuneAndRealTimeCommands. - ! Item was removed: - ----- Method: MIDIInputParser>>startSysExclusive: (in category 'private-state machine') ----- - startSysExclusive: cmdByte - "The beginning of a variable length 'system exclusive' command." - - sysExBuffer resetContents. - lastCmdByte := nil. "system exclusive commands clear running status" - lastSelector := nil. - state := #sysExclusive. - ! Item was removed: - ----- Method: MIDIInputParser>>undefined: (in category 'private-state machine') ----- - undefined: cmdByte - "We have received an unexpected MIDI byte (e.g., a data byte when we were expecting a command). This should never happen." - - self error: 'unexpected MIDI byte ', cmdByte printString. - ! Item was removed: - Object subclass: #MIDIScore - instanceVariableNames: 'tracks trackInfo ambientTrack tempoMap ticksPerQuarterNote source' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !MIDIScore commentStamp: '<historical>' prior: 0! - A MIDIScore is a container for a number of MIDI tracks as well as an ambient track for such things as sounds, book page triggers and other related events.! Item was removed: - ----- Method: MIDIScore>>addAmbientEvent: (in category 'ambient track') ----- - addAmbientEvent: evt - | i | - i := ambientTrack findFirst: [:e | e time >= evt time]. - i = 0 ifTrue: [^ ambientTrack := ambientTrack , (Array with: evt)]. - ambientTrack := ambientTrack copyReplaceFrom: i to: i-1 with: (Array with: evt)! Item was removed: - ----- Method: MIDIScore>>ambientEventAfter:ticks: (in category 'ambient track') ----- - ambientEventAfter: eventIndex ticks: scoreTicks - | evt | - (ambientTrack == nil or: [eventIndex > ambientTrack size]) ifTrue: [^ nil]. - evt := ambientTrack at: eventIndex. - evt time <= scoreTicks ifTrue: [^ evt]. - ^ nil! Item was removed: - ----- Method: MIDIScore>>ambientTrack (in category 'ambient track') ----- - ambientTrack - ^ ambientTrack ifNil: [ambientTrack := Array new]! Item was removed: - ----- Method: MIDIScore>>appendEvent:fullDuration:at: (in category 'editing') ----- - appendEvent: noteEvent fullDuration: fullDuration at: selection - "It is assumed that the noteEvent already has the proper time" - - | track noteLoc | - track := tracks at: selection first. - noteLoc := selection third + 1. - noteEvent midiKey = -1 - ifTrue: [noteLoc := noteLoc - 1] - ifFalse: ["If not a rest..." - track := track copyReplaceFrom: noteLoc to: noteLoc - 1 - with: (Array with: noteEvent)]. - track size >= (noteLoc + 1) ifTrue: - ["Adjust times of following events" - noteLoc + 1 to: track size do: - [:i | (track at: i) adjustTimeBy: fullDuration]]. - tracks at: selection first put: track! Item was removed: - ----- Method: MIDIScore>>cutSelection: (in category 'editing') ----- - cutSelection: selection - - | track selStartTime delta | - track := tracks at: selection first. - selStartTime := (track at: selection second) time. - track := track copyReplaceFrom: selection second to: selection third with: Array new. - track size >= selection second ifTrue: - ["Adjust times of following events" - delta := selStartTime - (track at: selection second) time. - selection second to: track size do: - [:i | (track at: i) adjustTimeBy: delta]]. - tracks at: selection first put: track! Item was removed: - ----- Method: MIDIScore>>durationInTicks (in category 'accessing') ----- - durationInTicks - - | t | - t := 0. - tracks, {self ambientTrack} do: - [:track | - track do: - [:n | (n isNoteEvent) - ifTrue: [t := t max: n endTime] - ifFalse: [t := t max: n time]]]. - ^ t - ! Item was removed: - ----- Method: MIDIScore>>eventForTrack:after:ticks: (in category 'editing') ----- - eventForTrack: trackIndex after: eventIndex ticks: scoreTick - - | track evt | - track := tracks at: trackIndex. - eventIndex > track size ifTrue: [^ nil]. - evt := track at: eventIndex. - evt time > scoreTick ifTrue: [^ nil]. - ^ evt - ! Item was removed: - ----- Method: MIDIScore>>eventMorphsDo: (in category 'ambient track') ----- - eventMorphsDo: aBlock - "Evaluate aBlock for all morphs related to the ambient events." - - ambientTrack == nil ifTrue: [^ self]. - ambientTrack do: [:evt | evt morph ifNotNil: aBlock]. - ! Item was removed: - ----- Method: MIDIScore>>eventMorphsWithTimeDo: (in category 'ambient track') ----- - eventMorphsWithTimeDo: aBlock - "Evaluate aBlock for all morphs and times related to the ambient events." - - ambientTrack == nil ifTrue: [^ self]. - ambientTrack do: [:evt | evt morph ifNotNil: [aBlock value: evt morph value: evt time]]. - ! Item was removed: - ----- Method: MIDIScore>>gridToNextQuarterNote: (in category 'editing') ----- - gridToNextQuarterNote: tickTime - - ^ self gridToQuarterNote: tickTime + ticksPerQuarterNote! Item was removed: - ----- Method: MIDIScore>>gridToQuarterNote: (in category 'editing') ----- - gridToQuarterNote: tickTime - - ^ tickTime truncateTo: ticksPerQuarterNote! Item was removed: - ----- Method: MIDIScore>>gridTrack:toQuarter:at: (in category 'editing') ----- - gridTrack: trackIndex toQuarter: quarterDelta at: indexInTrack - - | track selStartTime delta | - track := tracks at: trackIndex. - selStartTime := (track at: indexInTrack) time. - delta := (self gridToQuarterNote: selStartTime + (quarterDelta*ticksPerQuarterNote)) - - selStartTime. - indexInTrack to: track size do: - [:i | (track at: i) adjustTimeBy: delta]. - ! Item was removed: - ----- Method: MIDIScore>>initialize (in category 'initialization') ----- - initialize - - super initialize. - tracks := #(). - ambientTrack := Array new. - tempoMap := #(). - ticksPerQuarterNote := 100. - ! Item was removed: - ----- Method: MIDIScore>>insertEvents:at: (in category 'editing') ----- - insertEvents: events at: selection - - | track selStartTime delta | - track := tracks at: selection first. - selection second = 0 - ifTrue: [selStartTime := 0. - selection at: 2 put: 1] - ifFalse: [selStartTime := (track at: selection second) time]. - track := track copyReplaceFrom: selection second to: selection second - 1 - with: (events collect: [:e | e copy]). - track size >= (selection second + events size) ifTrue: - ["Adjust times of following events" - delta := selStartTime - (track at: selection second) time. - selection second to: selection second + events size - 1 do: - [:i | (track at: i) adjustTimeBy: delta]. - delta := (self gridToNextQuarterNote: (track at: selection second + events size - 1) endTime) - - (track at: selection second + events size) time. - selection second + events size to: track size do: - [:i | (track at: i) adjustTimeBy: delta]. - ]. - tracks at: selection first put: track! Item was removed: - ----- Method: MIDIScore>>jitterStartAndEndTimesBy: (in category 'editing') ----- - jitterStartAndEndTimesBy: mSecs - - | r range halfRange | - r := Random new. - range := 2.0 * mSecs. - halfRange := mSecs. - tracks do: [:t | - t do: [:e | | newEnd newStart oldEnd | - e isNoteEvent ifTrue: [ - oldEnd := e time + e duration. - newEnd := oldEnd + ((r next * range) asInteger - halfRange). - newStart := e time + ((r next * range) asInteger - halfRange). - e time: newStart. - e duration: (newEnd - newStart)]]]. - - ! Item was removed: - ----- Method: MIDIScore>>pauseFrom: (in category 'playing') ----- - pauseFrom: scorePlayer - self eventMorphsDo: [:p | p pauseFrom: scorePlayer]! Item was removed: - ----- Method: MIDIScore>>printOn: (in category 'printing') ----- - printOn: stream - - self source - ifNotNil: [:s | s printOn: stream] - ifNil: [super printOn: stream].! Item was removed: - ----- Method: MIDIScore>>removeAmbientEventWithMorph: (in category 'ambient track') ----- - removeAmbientEventWithMorph: aMorph - | i | - i := ambientTrack findFirst: [:e | e morph == aMorph]. - i = 0 ifTrue: [^ self]. - ambientTrack := ambientTrack copyReplaceFrom: i to: i with: Array new! Item was removed: - ----- Method: MIDIScore>>resetFrom: (in category 'playing') ----- - resetFrom: scorePlayer - self eventMorphsDo: [:p | p resetFrom: scorePlayer]! Item was removed: - ----- Method: MIDIScore>>resumeFrom: (in category 'playing') ----- - resumeFrom: scorePlayer - self eventMorphsDo: [:p | p resumeFrom: scorePlayer]! Item was removed: - ----- Method: MIDIScore>>source (in category 'accessing') ----- - source - ^ source! Item was removed: - ----- Method: MIDIScore>>source: (in category 'accessing') ----- - source: anObject - source := anObject.! Item was removed: - ----- Method: MIDIScore>>tempoMap (in category 'accessing') ----- - tempoMap - - ^ tempoMap - ! Item was removed: - ----- Method: MIDIScore>>tempoMap: (in category 'accessing') ----- - tempoMap: tempoEventList - - tempoEventList ifNil: [ - tempoMap := #(). - ^ self]. - tempoMap := tempoEventList asArray. - ! Item was removed: - ----- Method: MIDIScore>>ticksPerQuarterNote (in category 'accessing') ----- - ticksPerQuarterNote - - ^ ticksPerQuarterNote - ! Item was removed: - ----- Method: MIDIScore>>ticksPerQuarterNote: (in category 'accessing') ----- - ticksPerQuarterNote: anInteger - - ticksPerQuarterNote := anInteger. - ! Item was removed: - ----- Method: MIDIScore>>trackInfo (in category 'accessing') ----- - trackInfo - - ^ trackInfo ifNil: [tracks collect: [:i | String new]] - ! Item was removed: - ----- Method: MIDIScore>>trackInfo: (in category 'accessing') ----- - trackInfo: trackInfoList - - trackInfo := trackInfoList asArray. - ! Item was removed: - ----- Method: MIDIScore>>tracks (in category 'accessing') ----- - tracks - - ^ tracks - ! Item was removed: - ----- Method: MIDIScore>>tracks: (in category 'accessing') ----- - tracks: trackList - - tracks := trackList asArray collect: [:trackEvents | trackEvents asArray]. - self ambientTrack. "Assure it's not nil"! Item was removed: - ----- Method: MIDIScore>>tracks:trackInfo: (in category 'accessing') ----- - tracks: trackList trackInfo: trackInfoList - - self tracks: trackList; trackInfo: trackInfoList.! Item was removed: - ScorePlayer subclass: #MIDISound - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !MIDISound commentStamp: 'mt 4/6/2016 10:19' prior: 0! - This empty class just makes the fact explicit that this object is a sound object that needs can be played. Just like other sounds. - - Example: (MIDISound fromFileNamed: 'some.mid') play! Item was removed: - ----- Method: MIDISound>>play (in category 'playing') ----- - play - "The base class ScorePlayer has two interfaces: a sound and a sound player. Choose the right interface depending on whether MIDI support is present." - - SoundService soundEnabled ifFalse: [^ self]. - - SimpleMIDIPort useMIDIDeviceForOutput ifTrue: [ - [self openMIDIPort] - on: Error - do: [ - SimpleMIDIPort askForDefault. - [self openMIDIPort] - on: Error - do: [ - self inform: 'Use of MIDI device is not working. Using custom synthesis.\Go to preferences to change again.' withCRs. - SimpleMIDIPort useMIDIDeviceForOutput: false]]]. - - self reset; resumePlaying.! Item was removed: - Object subclass: #MIDISynth - instanceVariableNames: 'midiParser channels process' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !MIDISynth commentStamp: '<historical>' prior: 0! - I implement a simple real-time MIDI synthesizer on platforms that support MIDI input. I work best on platforms that allow the sound buffer to be made very short--under 50 milliseconds is good and under 20 milliseconds is preferred (see below). The buffer size is changed by modifying the class initialization method of SoundPlayer and executing the do-it there to re-start the sound player. - - Each instance of me takes input from a single MIDI input port. Multiple instances of me can be used to handle multiple MIDI input ports. I distribute incoming commands among my sixteen MIDISynthChannel objects. Most of the interpretation of the MIDI commands is done by these channel objects. - - Buffer size notes: At the moment, most fast PowerPC Macintosh computers can probably work with buffer sizes down to 50 milliseconds, and the Powerbook G3 works down to about 15 milliseconds. You will need to experiment to discover the minimum buffer size that does not result in clicking during sound output. (Hint: Be sure to turn off power cycling on your Powerbook. Other applications and extensions can steal cycles from Squeak, causing intermittent clicking. Experimentation may be necessary to find a configuration that works for you.) - ! Item was removed: - ----- Method: MIDISynth class>>example (in category 'examples') ----- - example - "Here's one way to run the MIDI synth. It will get a nice Morphic UI later. Click the mouse to stop running it. (Mac users note: be sure you have MIDI interface adaptor plugged in, or Squeak will hang waiting for the external clock signal.)." - "MIDISynth example" - - | portNum synth | - portNum := SimpleMIDIPort inputPortNumFromUser. - portNum ifNil: [^ self]. - SoundPlayer useShortBuffer. - synth := MIDISynth new - midiPort: (SimpleMIDIPort openOnPortNumber: portNum). - synth midiParser ignoreCommand: 224. "filter out pitch bends" - 1 to: 16 do: [:i | - (synth channel: i) instrument: - (AbstractSound soundNamed: 'oboe1')]. - 1 to: 16 do: [:ch | synth volumeForChannel: ch put: 0.2]. - - synth processMIDIUntilMouseDown. - SoundPlayer shutDown: true; initialize. "revert to normal buffer size" - ! Item was removed: - ----- Method: MIDISynth>>channel: (in category 'channels') ----- - channel: i - - ^ channels at: i - ! Item was removed: - ----- Method: MIDISynth>>closeMIDIPort (in category 'midi port') ----- - closeMIDIPort - - midiParser midiPort ifNil: [^ self]. - midiParser midiPort close. - midiParser midiPort: nil. - ! Item was removed: - ----- Method: MIDISynth>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - midiParser := MIDIInputParser on: nil. - channels := (1 to: 16) collect: [:ch | MIDISynthChannel new initialize]. - ! Item was removed: - ----- Method: MIDISynth>>instrumentForChannel: (in category 'channels') ----- - instrumentForChannel: channelIndex - - ^ (channels at: channelIndex) instrument - ! Item was removed: - ----- Method: MIDISynth>>instrumentForChannel:put: (in category 'channels') ----- - instrumentForChannel: channelIndex put: aSoundProto - - (channels at: channelIndex) instrument: aSoundProto. - ! Item was removed: - ----- Method: MIDISynth>>isOn (in category 'testing') ----- - isOn - - ^ process notNil - ! Item was removed: - ----- Method: MIDISynth>>midiParser (in category 'accessing') ----- - midiParser - - ^ midiParser - ! Item was removed: - ----- Method: MIDISynth>>midiPort (in category 'midi port') ----- - midiPort - - ^ midiParser midiPort - ! Item was removed: - ----- Method: MIDISynth>>midiPort: (in category 'midi port') ----- - midiPort: aMIDIPortOrNil - - midiParser midiPort: aMIDIPortOrNil. - ! Item was removed: - ----- Method: MIDISynth>>midiTrackingLoop (in category 'tracking') ----- - midiTrackingLoop - - midiParser clearBuffers. - - [self processMIDI ifFalse: [(Delay forMilliseconds: 5) wait]] repeat! Item was removed: - ----- Method: MIDISynth>>mutedForChannel:put: (in category 'channels') ----- - mutedForChannel: channelIndex put: aBoolean - - ^ (channels at: channelIndex) muted: aBoolean - ! Item was removed: - ----- Method: MIDISynth>>panForChannel: (in category 'channels') ----- - panForChannel: channelIndex - - ^ (channels at: channelIndex) pan - ! Item was removed: - ----- Method: MIDISynth>>panForChannel:put: (in category 'channels') ----- - panForChannel: channelIndex put: newPan - - (channels at: channelIndex) pan: newPan. - ! Item was removed: - ----- Method: MIDISynth>>processMIDI (in category 'private-tracking') ----- - processMIDI - "Process some MIDI commands. Answer true if any commands were processed." - - | didSomething | - didSomething := false. - midiParser midiDo: [:item | | cmdByte byte1 chan cmd byte2 | - didSomething := true. - cmdByte := item at: 2. - byte1 := byte2 := nil. - item size > 2 ifTrue: [ - byte1 := item at: 3. - item size > 3 ifTrue: [byte2 := item at: 4]]. - cmdByte < 240 - ifTrue: [ "channel message" - cmd := cmdByte bitAnd: 2r11110000. - chan := (cmdByte bitAnd: 2r00001111) + 1. - (channels at: chan) doChannelCmd: cmd byte1: byte1 byte2: byte2] - ifFalse: [ "system message" - "process system messages here" - ]]. - ^ didSomething - ! Item was removed: - ----- Method: MIDISynth>>processMIDIUntilMouseDown (in category 'private-tracking') ----- - processMIDIUntilMouseDown - "Used for debugging. Do MIDI processing until the mouse is pressed." - - midiParser clearBuffers. - [Sensor anyButtonPressed] whileFalse: [self processMIDI]. - ! Item was removed: - ----- Method: MIDISynth>>setAllChannelMasterVolumes: (in category 'channels') ----- - setAllChannelMasterVolumes: aNumber - - | vol | - vol := (aNumber asFloat min: 1.0) max: 0.0. - channels do: [:ch | ch masterVolume: vol]. - ! Item was removed: - ----- Method: MIDISynth>>startMIDITracking (in category 'tracking') ----- - startMIDITracking - - midiParser ifNil: [^ self]. - midiParser midiPort ifNil: [^ self]. - midiParser midiPort ensureOpen. - self stopMIDITracking. - SoundPlayer useShortBuffer. - process := [self midiTrackingLoop] newProcess. - process priority: Processor userInterruptPriority. - process resume. - ! Item was removed: - ----- Method: MIDISynth>>stopMIDITracking (in category 'tracking') ----- - stopMIDITracking - - process ifNotNil: [ - process terminate. - process := nil]. - SoundPlayer shutDown: true; initialize. "revert to normal buffer size" - ! Item was removed: - ----- Method: MIDISynth>>volumeForChannel: (in category 'channels') ----- - volumeForChannel: channelIndex - - ^ (channels at: channelIndex) masterVolume - ! Item was removed: - ----- Method: MIDISynth>>volumeForChannel:put: (in category 'channels') ----- - volumeForChannel: channelIndex put: newVolume - - (channels at: channelIndex) masterVolume: newVolume. - ! Item was removed: - Object subclass: #MIDISynthChannel - instanceVariableNames: 'channel instrument muted masterVolume channelVolume pan pitchBend activeSounds' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !MIDISynthChannel commentStamp: '<historical>' prior: 0! - I implement one polyphonic channel of a 16-channel MIDI synthesizer. Many MIDI commands effect all the notes played on a particular channel, so I record the state for a single channel, including a list of notes currently playing. - - This initial implementation is extremely spartan, having just enough functionality to play notes. Things that are not implemented include: - - 1. program changes - 2. sustain pedal - 3. aftertouch (either kind) - 4. most controllers - 5. portamento - 6. mono-mode - ! Item was removed: - ----- Method: MIDISynthChannel>>adjustPitch: (in category 'other') ----- - adjustPitch: bend - "Handle a pitch-bend change." - - | pitchAdj | - pitchBend := bend. - pitchAdj := 2.0 raisedTo: (bend asFloat / 8192.0) / 6.0. - activeSounds copy do: [:entry | | snd centerPitch | - snd := entry at: 2. - centerPitch := entry at: 3. - snd pitch: pitchAdj * centerPitch. - snd internalizeModulationAndRatio]. - ! Item was removed: - ----- Method: MIDISynthChannel>>channelPressure: (in category 'midi dispatching') ----- - channelPressure: newPressure - "Handle a channel pressure (channel aftertouch) change." - - self newVolume: newPressure. - ! Item was removed: - ----- Method: MIDISynthChannel>>control:value: (in category 'midi dispatching') ----- - control: control value: newValue - "Handle a continuous controller change." - - control = 2 ifTrue: [self newVolume: newValue]. "breath controller" - ! Item was removed: - ----- Method: MIDISynthChannel>>convertVelocity: (in category 'other') ----- - convertVelocity: valueByte - "Map a value in the range 0..127 to a volume in the range 0.0..1.0." - "Details: A quadratic function seems to give a good keyboard feel." - - | r | - r := (valueByte * valueByte) / 12000.0. - r > 1.0 ifTrue: [^ 1.0]. - r < 0.08 ifTrue: [^ 0.08]. - ^ r - ! Item was removed: - ----- Method: MIDISynthChannel>>doChannelCmd:byte1:byte2: (in category 'midi dispatching') ----- - doChannelCmd: cmdByte byte1: byte1 byte2: byte2 - "Dispatch a channel command with the given arguments." - "Details: Cases appear in order of expected frequency, most frequent cases first." - - cmdByte = 144 ifTrue: [ - byte2 = 0 - ifTrue: [^ self keyUp: byte1 vel: 0] - ifFalse: [^ self keyDown: byte1 vel: byte2]]. - cmdByte = 128 ifTrue: [^ self keyUp: byte1 vel: byte2]. - cmdByte = 224 ifTrue: [^ self pitchBend: ((byte2 bitShift: 7) + byte1) - 8192]. - cmdByte = 176 ifTrue: [^ self control: byte1 value: byte2]. - cmdByte = 208 ifTrue: [^ self channelPressure: byte1]. - cmdByte = 160 ifTrue: [^ self key: byte1 pressure: byte2]. - cmdByte = 192 ifTrue: [^ self programChange: byte1]. - ! Item was removed: - ----- Method: MIDISynthChannel>>initialize (in category 'initialization') ----- - initialize - - super initialize. - instrument := FMSound default. - muted := false. - masterVolume := 0.5. - channelVolume := 1.0. - pan := 0.5. - pitchBend := 0.0. - activeSounds := OrderedCollection new. - ! Item was removed: - ----- Method: MIDISynthChannel>>instrument (in category 'accessing') ----- - instrument - - ^ instrument - ! Item was removed: - ----- Method: MIDISynthChannel>>instrument: (in category 'accessing') ----- - instrument: aSound - - instrument := aSound. - ! Item was removed: - ----- Method: MIDISynthChannel>>key:pressure: (in category 'midi dispatching') ----- - key: key pressure: press - "Handle a key pressure (polyphonic aftertouch) change. Rarely implemented." - - "Do nothing for now." - ! Item was removed: - ----- Method: MIDISynthChannel>>keyDown:vel: (in category 'midi dispatching') ----- - keyDown: key vel: vel - "Handle a key down event with non-zero velocity." - - | pitch snd | - muted ifTrue: [^ self]. - pitch := AbstractSound pitchForMIDIKey: key. - snd := instrument - soundForPitch: pitch - dur: 10000.0 "sustain a long time, or until turned off" - loudness: masterVolume * channelVolume * (self convertVelocity: vel). - snd := (MixedSound new add: snd pan: pan) reset. - SoundPlayer resumePlaying: snd quickStart: false. - activeSounds add: (Array with: key with: snd with: pitch). - ! Item was removed: - ----- Method: MIDISynthChannel>>keyUp:vel: (in category 'midi dispatching') ----- - keyUp: key vel: vel - "Handle a key up event." - - - activeSounds copy do: [:entry | | snd | - (entry at: 1) = key ifTrue: [ - snd := entry at: 2. - snd stopGracefully. - activeSounds remove: entry]]. - ! Item was removed: - ----- Method: MIDISynthChannel>>masterVolume (in category 'accessing') ----- - masterVolume - - ^ masterVolume - ! Item was removed: - ----- Method: MIDISynthChannel>>masterVolume: (in category 'accessing') ----- - masterVolume: aNumber - "Set the master volume the the given value (0.0 to 1.0)." - - masterVolume := aNumber asFloat. - ! Item was removed: - ----- Method: MIDISynthChannel>>muted (in category 'accessing') ----- - muted - - ^ muted - ! Item was removed: - ----- Method: MIDISynthChannel>>muted: (in category 'accessing') ----- - muted: aBoolean - - muted := aBoolean. - ! Item was removed: - ----- Method: MIDISynthChannel>>newVolume: (in category 'other') ----- - newVolume: valueByte - "Set the channel volume to the level given by the given number in the range 0..127." - - | newVolume | - channelVolume := valueByte asFloat / 127.0. - newVolume := masterVolume * channelVolume. - activeSounds do: [:entry | | snd | - snd := entry at: 2. - snd adjustVolumeTo: newVolume overMSecs: 10]. - ! Item was removed: - ----- Method: MIDISynthChannel>>pan (in category 'accessing') ----- - pan - - ^ pan - ! Item was removed: - ----- Method: MIDISynthChannel>>pan: (in category 'accessing') ----- - pan: aNumber - "Set the left-right pan to the given value (0.0 to 1.0)." - - pan := aNumber asFloat. - ! Item was removed: - ----- Method: MIDISynthChannel>>pitchBend: (in category 'midi dispatching') ----- - pitchBend: bend - "Handle a pitch-bend change." - - self adjustPitch: bend. - ! Item was removed: - ----- Method: MIDISynthChannel>>programChange: (in category 'midi dispatching') ----- - programChange: newProgram - "Handle a program (instrument) change." - - "Do nothing for now." - ! Item was removed: - AbstractSound subclass: #MixedSound - instanceVariableNames: 'sounds leftVols rightVols soundDone' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: MixedSound>>+ (in category 'composition') ----- - + aSound - "Return the mix of the receiver and the argument sound." - - self add: aSound - ! Item was removed: - ----- Method: MixedSound>>add: (in category 'composition') ----- - add: aSound - "Add the given sound with a pan setting of centered and no attenuation." - - self add: aSound pan: 0.5 volume: 1.0. - ^aSound - ! Item was removed: - ----- Method: MixedSound>>add:pan: (in category 'composition') ----- - add: aSound pan: leftRightPan - "Add the given sound with the given left-right panning and no attenuation." - - self add: aSound pan: leftRightPan volume: 1.0. - ! Item was removed: - ----- Method: MixedSound>>add:pan:volume: (in category 'composition') ----- - add: aSound pan: leftRightPan volume: volume - "Add the given sound with the given left-right pan, where 0.0 is full left, 1.0 is full right, and 0.5 is centered. The loudness of the sound will be scaled by volume, which ranges from 0 to 1.0." - - | pan vol | - pan := ((leftRightPan * ScaleFactor) asInteger max: 0) min: ScaleFactor. - vol := ((volume * ScaleFactor) asInteger max: 0) min: ScaleFactor. - "Sounds have state. If a sound occurs more than once in sounds then mixing can produce some very strange results" - sounds := sounds copyWith: ((sounds includes: aSound) ifTrue: [aSound copy] ifFalse: [aSound]). - leftVols := leftVols copyWith: ((ScaleFactor - pan) * vol) // ScaleFactor. - rightVols := rightVols copyWith: (pan * vol) // ScaleFactor! Item was removed: - ----- Method: MixedSound>>copySounds (in category 'copying') ----- - copySounds - "Private!! Support for copying. Copy my component sounds and settings array." - - sounds := sounds collect: [:s | s copy]. - leftVols := leftVols copy. - rightVols := rightVols copy. - ! Item was removed: - ----- Method: MixedSound>>doControl (in category 'sound generation') ----- - doControl - - super doControl. - 1 to: sounds size do: [:i | (sounds at: i) doControl]. - ! Item was removed: - ----- Method: MixedSound>>duration (in category 'accessing') ----- - duration - "Answer the duration of this sound in seconds." - - | dur | - dur := 0. - sounds do: [:snd | dur := dur max: snd duration]. - ^ dur - ! Item was removed: - ----- Method: MixedSound>>initialize (in category 'initialization') ----- - initialize - - super initialize. - sounds := Array new. - leftVols := Array new. - rightVols := Array new. - ! Item was removed: - ----- Method: MixedSound>>isStereo (in category 'accessing') ----- - isStereo - - ^ true - ! Item was removed: - ----- Method: MixedSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play a number of sounds concurrently. The level of each sound can be set independently for the left and right channels." - - | snd left right | - soundDone - ifNil: - [1 to: sounds size do: - [:i | - snd := sounds at: i. - left := (leftVol * (leftVols at: i) * scaledVol / ScaleFactor) // ScaleFactor. - right := (rightVol * (rightVols at: i) * scaledVol / ScaleFactor) // ScaleFactor. - snd samplesRemaining > 0 ifTrue: - [snd mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: left rightVol: right]]] - ifNotNil: - [1 to: sounds size do: - [:i | - (soundDone at: i) ifFalse: - [snd := sounds at: i. - left := (leftVol * (leftVols at: i) * scaledVol / ScaleFactor) // ScaleFactor. - right := (rightVol * (rightVols at: i) * scaledVol / ScaleFactor) // ScaleFactor. - snd samplesRemaining > 0 - ifTrue: [snd mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: left rightVol: right] - ifFalse: [soundDone at: i put: true]]]]! Item was removed: - ----- Method: MixedSound>>postCopy (in category 'copying') ----- - postCopy - "Copy my component sounds." - - super postCopy. - self copySounds - ! Item was removed: - ----- Method: MixedSound>>reset (in category 'sound generation') ----- - reset - - super reset. - sounds do: [:snd | snd reset]. - soundDone := (Array new: sounds size) atAllPut: false. - ! Item was removed: - ----- Method: MixedSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - | remaining r | - remaining := 0. - 1 to: sounds size do: [:i | - r := (sounds at: i) samplesRemaining. - r > remaining ifTrue: [remaining := r]]. - - ^ remaining - ! Item was removed: - ----- Method: MixedSound>>sounds (in category 'accessing') ----- - sounds - - ^ sounds - ! Item was removed: - ----- Method: MixedSound>>stopGracefully (in category 'sound generation') ----- - stopGracefully - "End this note with a graceful decay. If the note has envelopes, determine the decay time from its envelopes." - - super stopGracefully. - sounds do: [:s | s stopGracefully]. - ! Item was removed: - SoundCodec subclass: #MuLawCodec - instanceVariableNames: '' - classVariableNames: 'DecodingTable' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !MuLawCodec commentStamp: '<historical>' prior: 0! - I represent a mu-law (u-law) codec. I compress sound data by a factor of 2:1 by encoding the most significant 12 bits of each 16-bit sample as a signed, exponentially encoded byte. The idea is to use more resolution for smaller lower sample values. This encoding was developed for the North American phone system and a variant of it, a-law, is a European phone standard. It is a popular sound encoding on Unix platforms (.au files). - ! Item was removed: - ----- Method: MuLawCodec class>>initialize (in category 'class initialization') ----- - initialize - "Build the 256 entry table to be used to decode 8-bit uLaw-encoded samples." - "MuLawCodec initialize" - - | encoded codec lastEncodedPos lastEncodedNeg | - DecodingTable := Array new: 256. - codec := self new. - lastEncodedPos := nil. - lastEncodedNeg := nil. - 4095 to: 0 by: -1 do: [:s | - encoded := codec uLawEncode12Bits: s. - lastEncodedPos = encoded - ifFalse: [ - DecodingTable at: (encoded + 1) put: (s bitShift: 3). - lastEncodedPos := encoded]. - encoded := encoded bitOr: 16r80. - lastEncodedNeg = encoded - ifFalse: [ - DecodingTable at: (encoded + 1) put: (s bitShift: 3) negated. - lastEncodedNeg := encoded]]. - ! Item was removed: - ----- Method: MuLawCodec>>bytesPerEncodedFrame (in category 'subclass responsibility') ----- - bytesPerEncodedFrame - "Answer the number of bytes required to hold one frame of compressed sound data. Answer zero if this codec produces encoded frames of variable size." - - ^ 1 - ! Item was removed: - ----- Method: MuLawCodec>>decodeFrames:from:at:into:at: (in category 'subclass responsibility') ----- - 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." - - | dst | - dst := dstIndex. - srcIndex to: srcIndex + frameCount - 1 do: [:src | - dstSoundBuffer at: dst put: (DecodingTable at: (srcByteArray at: src) + 1). - dst := dst + 1]. - ^ Array with: frameCount with: frameCount - ! Item was removed: - ----- Method: MuLawCodec>>encodeFrames:from:at:into:at: (in category 'subclass responsibility') ----- - 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." - - srcIndex to: srcIndex + frameCount - 1 do: [:i | - dstByteArray at: i put: (self uLawEncodeSample: (srcSoundBuffer at: i))]. - ^ Array with: frameCount with: frameCount - ! Item was removed: - ----- Method: MuLawCodec>>samplesPerFrame (in category 'subclass responsibility') ----- - samplesPerFrame - "Answer the number of sound samples per compression frame." - - ^ 1 - ! Item was removed: - ----- Method: MuLawCodec>>uLawDecodeSample: (in category 'external access') ----- - uLawDecodeSample: byte - "Decode a 16-bit signed sample from 8 bits using uLaw decoding" - - ^ DecodingTable at: byte + 1! Item was removed: - ----- Method: MuLawCodec>>uLawEncode12Bits: (in category 'private') ----- - uLawEncode12Bits: s - "Encode a 12-bit unsigned sample (0-4095) into 7 bits using uLaw encoding. - This gets called by a method that scales 16-bit signed integers down to a - 12-bit magnitude, and then ORs in 16r80 if they were negative. - Detail: May get called with s >= 4096, and this works fine." - - s < 496 ifTrue: [ - s < 112 ifTrue: [ - s < 48 ifTrue: [ - s < 16 - ifTrue: [^ 16r70 bitOr: (15 - s)] - ifFalse: [^ 16r60 bitOr: (15 - ((s - 16) bitShift: -1))]]. - ^ 16r50 bitOr: (15 - ((s - 48) bitShift: -2))]. - s < 240 - ifTrue: [^ 16r40 bitOr: (15 - ((s - 112) bitShift: -3))] - ifFalse: [^ 16r30 bitOr: (15 - ((s - 240) bitShift: -4))]]. - - s < 2032 ifTrue: [ - s < 1008 - ifTrue: [^ 16r20 bitOr: (15 - ((s - 496) bitShift: -5))] - ifFalse: [^ 16r10 bitOr: (15 - ((s - 1008) bitShift: -6))]]. - - s < 4080 - ifTrue: [^ 15 - ((s - 2032) bitShift: -7)] - ifFalse: [^ 0]. - ! Item was removed: - ----- Method: MuLawCodec>>uLawEncodeSample: (in category 'external access') ----- - uLawEncodeSample: sample - "Encode a 16-bit signed sample into 8 bits using uLaw encoding" - - | s | - s := sample // 8. "drop 3 least significant bits" - s < 0 ifTrue: [^ (self uLawEncode12Bits: 0-s) + 16r80] - ifFalse: [^ (self uLawEncode12Bits: s)]. - ! Item was removed: - AbstractScoreEvent subclass: #NoteEvent - instanceVariableNames: 'duration midiKey velocity channel' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !NoteEvent commentStamp: '<historical>' prior: 0! - Represents a note on or off event in a MIDI score. - ! Item was removed: - ----- Method: NoteEvent>>channel (in category 'accessing') ----- - channel - - ^ channel - ! Item was removed: - ----- Method: NoteEvent>>channel: (in category 'accessing') ----- - channel: midiChannel - - channel := midiChannel. - ! Item was removed: - ----- Method: NoteEvent>>duration (in category 'accessing') ----- - duration - - ^ duration - ! Item was removed: - ----- Method: NoteEvent>>duration: (in category 'accessing') ----- - duration: aNumber - - duration := aNumber. - ! Item was removed: - ----- Method: NoteEvent>>endNoteOnMidiPort: (in category 'midi') ----- - endNoteOnMidiPort: aMidiPort - "Output a noteOff event to the given MIDI port. (Actually, output a noteOff event with zero velocity. This does the same thing, but allows running status to be used when sending a mixture of note on and off commands.)" - - aMidiPort - midiCmd: 16r90 - channel: channel - byte: midiKey - byte: 0. - ! Item was removed: - ----- Method: NoteEvent>>endTime (in category 'accessing') ----- - endTime - - ^ time + duration - ! Item was removed: - ----- Method: NoteEvent>>isNoteEvent (in category 'classification') ----- - isNoteEvent - - ^ true - ! Item was removed: - ----- Method: NoteEvent>>key:velocity:channel: (in category 'accessing') ----- - key: midiKeyNum velocity: midiVelocity channel: midiChannel - - midiKey := midiKeyNum. - velocity := midiVelocity. - channel := midiChannel. - ! Item was removed: - ----- Method: NoteEvent>>keyName (in category 'printing') ----- - keyName - "Return a note name for my pitch." - - | pitchName octave | - pitchName := #(c cs d ef e f fs g af a bf b) at: (midiKey \\ 12) + 1. - octave := (#(-1 0 1 2 3 4 5 6 7 8 9) at: (midiKey // 12) + 1) printString. - ^ pitchName, octave - ! Item was removed: - ----- Method: NoteEvent>>midiKey (in category 'accessing') ----- - midiKey - - ^ midiKey - ! Item was removed: - ----- Method: NoteEvent>>midiKey: (in category 'accessing') ----- - midiKey: midiKeyNum - - midiKey := midiKeyNum. - ! Item was removed: - ----- Method: NoteEvent>>pitch (in category 'accessing') ----- - pitch - "Convert my MIDI key number to a pitch and return it." - - ^ AbstractSound pitchForMIDIKey: midiKey - ! Item was removed: - ----- Method: NoteEvent>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPut: $(. - time printOn: aStream. - aStream nextPutAll: ': '. - aStream nextPutAll: self keyName. - aStream space. - duration printOn: aStream. - aStream nextPut: $). - ! Item was removed: - ----- Method: NoteEvent>>startNoteOnMidiPort: (in category 'midi') ----- - startNoteOnMidiPort: aMidiPort - "Output a noteOn event to the given MIDI port." - - aMidiPort - midiCmd: 16r90 - channel: channel - byte: midiKey - byte: velocity. - ! Item was removed: - ----- Method: NoteEvent>>velocity (in category 'accessing') ----- - velocity - - ^ velocity - ! Item was removed: - ----- Method: NoteEvent>>velocity: (in category 'accessing') ----- - velocity: midiVelocity - - velocity := midiVelocity. - ! Item was removed: - AbstractScoreEvent subclass: #PitchBendEvent - instanceVariableNames: 'bend channel' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! Item was removed: - ----- Method: PitchBendEvent>>bend (in category 'accessing') ----- - bend - - ^ bend - ! Item was removed: - ----- Method: PitchBendEvent>>bend: (in category 'accessing') ----- - bend: midiPitchBend - - bend := midiPitchBend. - ! Item was removed: - ----- Method: PitchBendEvent>>bend:channel: (in category 'accessing') ----- - bend: midiPitchBend channel: midiChannel - - bend := midiPitchBend. - channel := midiChannel. - ! Item was removed: - ----- Method: PitchBendEvent>>channel (in category 'accessing') ----- - channel - - ^ channel - ! Item was removed: - ----- Method: PitchBendEvent>>channel: (in category 'accessing') ----- - channel: midiChannel - - channel := midiChannel. - ! Item was removed: - ----- Method: PitchBendEvent>>isPitchBend (in category 'classification') ----- - isPitchBend - - ^ true - ! Item was removed: - ----- Method: PitchBendEvent>>outputOnMidiPort: (in category 'midi') ----- - outputOnMidiPort: aMidiPort - "Output this event to the given MIDI port." - - aMidiPort - midiCmd: 16rE0 - channel: channel - byte: (bend bitAnd: 16r7F) - byte: (bend bitShift: -7). - ! Item was removed: - ----- Method: PitchBendEvent>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPut: $(. - time printOn: aStream. - aStream nextPutAll: ': bend '. - bend printOn: aStream. - aStream nextPut: $). - ! Item was removed: - Envelope subclass: #PitchEnvelope - instanceVariableNames: 'centerPitch' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: PitchEnvelope>>centerPitch (in category 'accessing') ----- - centerPitch - - ^ centerPitch - ! Item was removed: - ----- Method: PitchEnvelope>>centerPitch: (in category 'accessing') ----- - centerPitch: aNumber - - centerPitch := aNumber. - ! Item was removed: - ----- Method: PitchEnvelope>>updateSelector (in category 'accessing') ----- - updateSelector - "Needed by the envelope editor." - - ^ #pitch: - ! Item was removed: - ----- Method: PitchEnvelope>>updateTargetAt: (in category 'applying') ----- - updateTargetAt: mSecs - "Update the pitch for my target. Answer true if the value changed." - "Details: Assume envelope range is 0.0..2.0, with 1 being the center pitch. Subtracting one yields the range -1.0..1.0. Raising two to this power yields pitches between half and double the center pitch; i.e. from an octave below to an octave about the center pitch." - - | newValue | - newValue := self valueAtMSecs: mSecs. - newValue ~= lastValue ifTrue: [ - target pitch: (2.0 raisedTo: newValue - (scale / 2.0)) * centerPitch. - lastValue := newValue. - ^ true]. - - ^ false - ! Item was removed: - AbstractSound subclass: #PluckedSound - instanceVariableNames: 'initialCount count ring scaledIndex scaledIndexIncr scaledIndexLimit' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !PluckedSound commentStamp: '<historical>' prior: 0! - The Karplus-Strong plucked string algorithm: start with a buffer full of random noise and repeatedly play the contents of that buffer while averaging adjacent samples. High harmonics damp out more quickly, transfering their energy to lower ones. The length of the buffer corresponds to the length of the string. Fractional indexing is used to allow precise tuning; without this, the pitch would be rounded to the pitch corresponding to the nearest buffer size. - ! Item was removed: - ----- Method: PluckedSound class>>default (in category 'instruments') ----- - default - "PluckedSound default play" - "(AbstractSound majorScaleOn: PluckedSound default) play" - - | snd p env | - snd := PluckedSound new. - p := OrderedCollection new. - p add: 0 at 1.0; add: 10 at 1.0; add: 20 at 0.0. - env := VolumeEnvelope points: p loopStart: 2 loopEnd: 2. - env target: snd; scale: 0.3. - ^ snd - addEnvelope: env; - setPitch: 220 dur: 3.0 loudness: 0.3 - ! Item was removed: - ----- Method: PluckedSound>>copyRing (in category 'copying') ----- - copyRing - "Private!! Support for copying" - - ring := ring copy. - ! Item was removed: - ----- Method: PluckedSound>>duration (in category 'accessing') ----- - duration - "Answer the duration of this sound in seconds." - - ^ initialCount asFloat / self samplingRate - ! Item was removed: - ----- Method: PluckedSound>>duration: (in category 'accessing') ----- - duration: seconds - - super duration: seconds. - count := initialCount := (seconds * self samplingRate) rounded. - ! Item was removed: - ----- Method: PluckedSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "The Karplus-Strong plucked string algorithm: start with a buffer full of random noise and repeatedly play the contents of that buffer while averaging adjacent samples. High harmonics damp out more quickly, transfering their energy to lower ones. The length of the buffer corresponds to the length of the string." - "(PluckedSound pitch: 220.0 dur: 6.0 loudness: 0.8) play" - - | lastIndex scaledThisIndex scaledNextIndex average sample i s | - <primitive:'primitiveMixPluckedSound' module:'SoundGenerationPlugin'> - <var: #aSoundBuffer declareC: 'short int *aSoundBuffer'> - <var: #ring declareC: 'short int *ring'> - - lastIndex := (startIndex + n) - 1. - scaledThisIndex := scaledNextIndex := scaledIndex. - startIndex to: lastIndex do: [:sliceIndex | - scaledNextIndex := scaledThisIndex + scaledIndexIncr. - scaledNextIndex >= scaledIndexLimit - ifTrue: [scaledNextIndex := ScaleFactor + (scaledNextIndex - scaledIndexLimit)]. - average := - ((ring at: scaledThisIndex // ScaleFactor) + - (ring at: scaledNextIndex // ScaleFactor)) // 2. - ring at: scaledThisIndex // ScaleFactor put: average. - sample := (average * scaledVol) // ScaleFactor. "scale by volume" - scaledThisIndex := scaledNextIndex. - - 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]. - - 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]]]. - - scaledIndex := scaledNextIndex. - count := count - n. - ! Item was removed: - ----- Method: PluckedSound>>postCopy (in category 'copying') ----- - postCopy - - super postCopy. - self copyRing - ! Item was removed: - ----- Method: PluckedSound>>reset (in category 'sound generation') ----- - reset - "Fill the ring with random noise." - - | seed n | - super reset. - seed := 17. - n := ring monoSampleCount. - 1 to: n do: [:i | - seed := ((seed * 1309) + 13849) bitAnd: 65535. - ring at: i put: seed - 32768]. - count := initialCount. - scaledIndex := ScaleFactor. - ! Item was removed: - ----- Method: PluckedSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - ^ count - ! Item was removed: - ----- Method: PluckedSound>>setPitch:dur:loudness: (in category 'initialization') ----- - setPitch: pitchNameOrNumber dur: d loudness: vol - - | p sz | - super setPitch: pitchNameOrNumber dur: d loudness: vol. - p := self nameOrNumberToPitch: pitchNameOrNumber. - initialCount := (d * self samplingRate asFloat) asInteger. - ring := SoundBuffer newMonoSampleCount: - (((2.0 * self samplingRate) / p) asInteger max: 2). - sz := ring monoSampleCount. - scaledIndexLimit := (sz + 1) * ScaleFactor. - scaledIndexIncr := (p * sz * ScaleFactor) // (2.0 * self samplingRate). - self reset. - ! Item was removed: - ----- Method: PluckedSound>>stopAfterMSecs: (in category 'sound generation') ----- - stopAfterMSecs: mSecs - "Terminate this sound this note after the given number of milliseconds." - - count := (mSecs * self samplingRate) // 1000. - ! Item was removed: - AbstractScoreEvent subclass: #ProgramChangeEvent - instanceVariableNames: 'program channel' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! Item was removed: - ----- Method: ProgramChangeEvent>>channel (in category 'accessing') ----- - channel - - ^ channel - ! Item was removed: - ----- Method: ProgramChangeEvent>>channel: (in category 'accessing') ----- - channel: midiChannel - - channel := midiChannel. - ! Item was removed: - ----- Method: ProgramChangeEvent>>isProgramChange (in category 'classification') ----- - isProgramChange - - ^ true - ! Item was removed: - ----- Method: ProgramChangeEvent>>outputOnMidiPort: (in category 'midi') ----- - outputOnMidiPort: aMidiPort - "Output this event to the given MIDI port." - - aMidiPort - midiCmd: 16rC0 - channel: channel - byte: program. - ! Item was removed: - ----- Method: ProgramChangeEvent>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPut: $(. - time printOn: aStream. - aStream nextPutAll: ': prog '. - program printOn: aStream. - aStream nextPut: $). - ! Item was removed: - ----- Method: ProgramChangeEvent>>program (in category 'accessing') ----- - program - - ^ program - ! Item was removed: - ----- Method: ProgramChangeEvent>>program: (in category 'accessing') ----- - program: midiProgramChange - - program := midiProgramChange. - ! Item was removed: - ----- Method: ProgramChangeEvent>>program:channel: (in category 'accessing') ----- - program: midiProgramChange channel: midiChannel - - program := midiProgramChange. - channel := midiChannel. - ! Item was removed: - ----- Method: Project>>beep (in category '*sound') ----- - beep - (PluckedSound pitch: 261.625*4 dur: 1 loudness: 0.1) play! Item was removed: - AbstractSound subclass: #QueueSound - instanceVariableNames: 'startTime sounds currentSound done' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !QueueSound commentStamp: 'nice 3/24/2010 07:38' prior: 0! - I am a queue for sound - give me a bunch of sounds to play and I will play them one at a time in the order that they are received. - - Example: - "Here is a simple example which plays two sounds three times." - | clink warble queue | - clink := SampledSound soundNamed: 'clink'. - warble := SampledSound soundNamed: 'warble'. - queue := QueueSound new. - 3 timesRepeat:[ - queue add: clink; add: warble - ]. - queue play. - - Structure: - startTime Integer -- if present, start playing when startTime <= Time millisecondClockValue - (schedule the sound to play later) - sounds SharedQueue -- the synchronized list of sounds. - currentSound AbstractSound -- the currently active sound - done Boolean -- am I done playing ? - - Other: - You may want to keep track of the queue's position so that you can feed it at an appropriate rate. To do this in an event driven way, modify or subclass nextSound to notify you when appropriate. You could also poll by checking currentSound, but this is not recommended for most applications. - - ! Item was removed: - ----- Method: QueueSound>>add: (in category 'accessing') ----- - add: aSound - self sounds nextPut: aSound. - ^ aSound! Item was removed: - ----- Method: QueueSound>>currentSound (in category 'accessing') ----- - currentSound - ^ currentSound ifNil: [currentSound := self nextSound]! Item was removed: - ----- Method: QueueSound>>currentSound: (in category 'accessing') ----- - currentSound: aSound - currentSound := aSound! Item was removed: - ----- Method: QueueSound>>doControl (in category 'sound generation') ----- - doControl - super doControl. - self currentSound ifNotNil: [:curSound | curSound doControl]! Item was removed: - ----- Method: QueueSound>>done: (in category 'accessing') ----- - done: aBoolean - done := aBoolean! Item was removed: - ----- Method: QueueSound>>initialize (in category 'initialization') ----- - initialize - super initialize. - sounds := SharedQueue new. - done := false. - startTime := Time millisecondClockValue! Item was removed: - ----- Method: QueueSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play a collection of sounds in sequence." - - | finalIndex i remaining count rate | - self currentSound ifNil: [^ self]. "already done" - self startTime > Time millisecondClockValue ifTrue: [^ self]. - rate := self samplingRate. - finalIndex := (startIndex + n) - 1. - i := startIndex. - [i <= finalIndex] whileTrue: [ - [ - self currentSound ifNil: [^ self]. - (remaining := self currentSound samplesRemaining) <= 0] - whileTrue: [self currentSound: self nextSound]. - count := (finalIndex - i) + 1. - remaining < count ifTrue: [count := remaining]. - self currentSound mixSampleCount: count into: aSoundBuffer startingAt: i leftVol: leftVol rightVol: rightVol. - i := i + count]! Item was removed: - ----- Method: QueueSound>>nextSound (in category 'sound generation') ----- - nextSound - | answer | - sounds isEmpty ifTrue: [^ nil]. - answer := sounds next. - answer reset. - ^ answer! Item was removed: - ----- Method: QueueSound>>reset (in category 'sound generation') ----- - reset - super reset. - self currentSound - ifNil: [self currentSound: self nextSound] - ifNotNil: [:curSound | curSound reset]! Item was removed: - ----- Method: QueueSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - (done and: [self sounds isEmpty]) - ifTrue: [^ 0] - ifFalse: [^ 1000000]. - ! Item was removed: - ----- Method: QueueSound>>sounds (in category 'accessing') ----- - sounds - ^ sounds! Item was removed: - ----- Method: QueueSound>>startTime (in category 'accessing') ----- - startTime - ^ startTime! Item was removed: - ----- Method: QueueSound>>startTime: (in category 'accessing') ----- - startTime: anInteger - startTime := anInteger! Item was removed: - Envelope subclass: #RandomEnvelope - instanceVariableNames: 'rand lowLimit highLimit delta' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: RandomEnvelope class>>for: (in category 'instance creation') ----- - for: aSelector - "Answer a random envelope for the given selector." - - ^ self new updateSelector: aSelector - ! Item was removed: - ----- Method: RandomEnvelope>>centerPitch: (in category 'accessing') ----- - centerPitch: aNumber - "If this envelope controls pitch, set its scale to the given number. Otherwise, do nothing." - - updateSelector = #pitch: ifTrue: [self scale: aNumber]. - ! Item was removed: - ----- Method: RandomEnvelope>>delta (in category 'accessing') ----- - delta - - ^ delta - ! Item was removed: - ----- Method: RandomEnvelope>>delta: (in category 'accessing') ----- - delta: aNumber - - delta := aNumber. - ! Item was removed: - ----- Method: RandomEnvelope>>duration (in category 'envelope compatibility') ----- - duration - - ^ 1.0 - ! Item was removed: - ----- Method: RandomEnvelope>>duration: (in category 'envelope compatibility') ----- - duration: seconds - "Do nothing." - ! Item was removed: - ----- Method: RandomEnvelope>>highLimit (in category 'accessing') ----- - highLimit - - ^ highLimit - ! Item was removed: - ----- Method: RandomEnvelope>>highLimit: (in category 'accessing') ----- - highLimit: aNumber - - highLimit := aNumber. - ! Item was removed: - ----- Method: RandomEnvelope>>initialize (in category 'initialization') ----- - initialize - - super initialize. - rand := Random new. - lowLimit := 0.994. - highLimit := 1.006. - delta := 0.0002. - currValue := 1.0. - scale := 1.0. - ! Item was removed: - ----- Method: RandomEnvelope>>lowLimit (in category 'accessing') ----- - lowLimit - - ^ lowLimit - ! Item was removed: - ----- Method: RandomEnvelope>>lowLimit: (in category 'accessing') ----- - lowLimit: aNumber - - lowLimit := aNumber. - ! Item was removed: - ----- Method: RandomEnvelope>>name (in category 'envelope compatibility') ----- - name - - ^ 'random ', updateSelector - ! Item was removed: - ----- Method: RandomEnvelope>>points (in category 'envelopeEditor compatibility') ----- - points - - | env | - points ifNil: [ - env := self target envelopes first. - points := OrderedCollection new. - points - add: 0@(self delta * 5 + 0.5); - add: (env points at: env loopStartIndex)x@(self highLimit -1 * 5 + 0.5); - add: (env points at: env loopEndIndex)x@(self highLimit -1 * 5 + 0.5); - add: (env points last)x@(self lowLimit -1 * 5 + 0.5). - loopStartIndex := 2. - loopEndIndex := 3. - ]. - ^points! Item was removed: - ----- Method: RandomEnvelope>>setPoints:loopStart:loopEnd: (in category 'envelopeEditor compatibility') ----- - setPoints: pointList loopStart: startIndex loopEnd: endIndex - - self delta: pointList first y - 0.5 / 5. - self highLimit: (pointList at: startIndex) y - 0.5 / 5 + 1. - self lowLimit: pointList last y - 0.5 / 5 + 1. - ^super setPoints: pointList loopStart: startIndex loopEnd: endIndex! Item was removed: - ----- Method: RandomEnvelope>>sustainEnd: (in category 'envelope compatibility') ----- - sustainEnd: seconds - "Do nothing." - ! Item was removed: - ----- Method: RandomEnvelope>>updateTargetAt: (in category 'applying') ----- - updateTargetAt: mSecs - "Send my updateSelector to the given target object with the value of this envelope at the given number of milliseconds from its onset. Answer true if the value changed." - - | r | - r := rand next. - r > 0.5 - ifTrue: [ - currValue := currValue + delta. - currValue > highLimit ifTrue: [currValue := highLimit]] - ifFalse: [ - currValue := currValue - delta. - currValue < lowLimit ifTrue: [currValue := lowLimit]]. - currValue = lastValue ifTrue: [^ false]. - ((target == nil) or: [updateSelector == nil]) ifTrue: [^ false]. - target - perform: updateSelector - with: scale * currValue. - lastValue := currValue. - ^ true - ! Item was removed: - ----- Method: RandomEnvelope>>volume: (in category 'accessing') ----- - volume: aNumber - "If this envelope controls volume, set its scale to the given number. Otherwise, do nothing." - - updateSelector = #volume: ifTrue: [self scale: aNumber]. - ! Item was removed: - AbstractSound subclass: #RepeatingSound - instanceVariableNames: 'sound iterationCount iteration samplesPerIteration' - classVariableNames: 'CarMotorSamples' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: RepeatingSound class>>carMotorSound (in category 'car motor example') ----- - carMotorSound - "Return a repeating sound for the sound of a car engine." - "RepeatingSound carMotorSound play" - - ^ self carMotorSound: 10.0! Item was removed: - ----- Method: RepeatingSound class>>carMotorSound: (in category 'car motor example') ----- - carMotorSound: speed - "Return a repeating sound for the sound of a car engine running at the given speed." - "(RepeatingSound carMotorSound: 2.0) play" - - CarMotorSamples ifNil: [self initializeCarMotor]. - ^ RepeatingSound repeatForever: - ((LoopedSampledSound - unloopedSamples: CarMotorSamples - pitch: 20.0 - samplingRate: 22050) - setPitch: speed dur: 100.0 loudness: 1.0) - ! Item was removed: - ----- Method: RepeatingSound class>>initializeCarMotor (in category 'car motor example') ----- - initializeCarMotor - "Initialize the samples array for the sound of a car engine." - - CarMotorSamples := SoundBuffer fromArray: #( - 36 199 190 508 332 167 253 302 788 884 1233 1145 977 904 991 1371 1361 1495 1253 1346 1696 1454 1631 1784 1752 1826 1389 1234 1202 1152 1188 1000 1048 898 724 937 1145 1537 2023 2079 2371 2156 2098 1855 1843 2208 2126 2218 1664 1457 1389 1454 1481 1458 1661 1400 1548 1499 1949 2055 2130 2220 2038 1904 1750 1993 2114 2272 2418 2101 1976 1791 2161 2690 2958 3013 2888 2798 2792 2875 3207 3627 3732 3842 3791 3836 3964 4082 4351 4550 4755 4746 4851 5180 5507 6100 6491 6533 6133 5394 4627 3886 3133 2209 1073 -368 -1876 -3170 -4067 -4641 -4963 -5049 -4922 -4634 -4147 -3544 -2805 -1962 -1219 -592 -326 -374 -627 -901 -1075 -1159 -1252 -1312 -1444 -1397 -1338 -1142 -748 -541 -350 -314 -265 -143 52 464 653 927 1269 1617 2048 2365 2654 2924 3306 3669 3855 3799 3160 2372 1629 1289 1635 1841 1838 1557 987 630 557 857 1005 868 435 -309 -1083 -1765 -2025 -2055 -2219 -2388 -2409 -2438 -2314 -2002 -1687 -1477 -1533 -1641 -1878 -1885 -1776 -1580 -1005 -525 -164 -84 396 768 1160 1788 2219 2365 1836 14 35 1097 988 1326 1423 2106 2191 1965 1829 1578 1835 1429 1570 1596 1301 1357 1233 1634 2386 2597 3037 3225 3406 3339 3049 2935 2611 2428 2340 2728 2621 2994 2599 2591 3010 3341 3922 3992 3824 2982 2128 1376 1455 1437 2022 1927 1730 1841 1832 2334 2942 3183 3124 3362 3342 3549 3322 3474 3686 4164 4550 4051 3701 2742 2656 3210 4011 4641 4416 3697 2998 3382 3715 3729 3687 3375 3521 3932 4273 4172 3970 3598 3675 4879 5887 6320 5794 4623 4179 4453 5626 6412 6353 5563 4689 4683 5058 5905 6270 6218 6134 5704 5297 4087 2627 1221 -181 -1351 -2616 -4341 -6598 -8702 -9888 -10087 -9286 -8357 -7568 -6878 -6063 -4839 -3540 -2281 -1176 -315 248 409 337 -353 -1326 -2135 -2392 -2324 -2288 -2486 -3272 -3618 -3573 -2804 -1503 -604 267 808 1389 2069 2643 3328 3964 4706 5502 6136 6163 5665 4956 4491 4507 4409 4042 3132 1996 998 330 -116 -475 -877 -1370 -1250 -1048 -851 -740 -1207 -1166 -1040 -395 405 441 342 -281 -763 -799 -774 -447 -319 -190 -120 115 182 91 207 387 959 1462 1811 1767 1335 972 730 979 1 157 1338 1347 807 591 232 417 696 664 1406 1512 2065 2416 2374 2539 2395 2483 2677 2674 2585 2299 1134 320 -336 -65 676 743 538 16 -374 -515 138 463 1043 1533 1786 2332 2258 2566 2663 2961 3599 3498 3518 2952 2309 2045 1667 1571 1504 1213 1118 1029 874 843 710 977 1377 1816 2236 2114 1989 1698 1618 1672 1682 1602 1382 1044 689 364 55 -24 4 322 669 948 1148 1193 1280 1463 1873 2261 2578 2654 2543 2312 1976 1772 1738 1763 1855 1834 1664 1469 1312 1399 1484 1732 1880 2004 2124 2090 2056 2000 2048 2227 2464 2670 2721 2511 2234 2056 2081 2263 2522 2737 2768 2728 2693 2711 2768 2891 3068 3182 3126 2913 2545 2171 1950 1820 1765 1710 1538 1319 1020 764 600 538 607 742 808 710 517 307 162 62 17 -8 -205 -486 -858 -1288 -1581 -1720 -1795 -1834 -1863 -1906 -1966 -1895 -1855 -1651 -1350 -1049 -721 -464 -265 -65 75 189 306 412 472 458 374 222 113 101 178 309 481 568 576 516 497 582 724 844 964 914 774 662 509 472 576 610 572 554 517 605 785 1008 1312 1555 1786 1957 2044 2081 2118 2193 2264 2328 2 335 2277 2205 2098 2002 1981 1982 2017 1972 1912 1788 1611 1519 1428 1393 1367 1209 1045 842 624 564 509 465 398 172 11 -157 -264 -259 -269 -248 -249 -222 -266 -355 -372 -288 -158 -55 1 71 91 102 228 420 619 798 829 930 1012 1047 1210 1359 1531 1676 1702 1787 1809 1729 1668 1653 1721 1808 1793 1747 1616 1485 1476 1516 1751 1961 2029 2057 2006 1955 1893 1904 1960 1967 1975 1934 1827 1814 1749 1809 1947 2037 2098 2067 1970 1754 1627 1667 1759 1904 1890 1819 1747 1644 1698 1746 1834 1959 1922 1887 1864 1712 1734 1770 1895 2029 2062 2153 2132 2203 2206 2202 2194 2075 2019 1889 1923 1930 2090 2250 2335 2372 2209 2085 1902 1805 1826 1843 1804 1761 1605 1580 1680 1713 1825 1904 2097 2269 2373 2384 2235 2351 2445 2530 2610 2560 2618 2511 2445 2374 2111 1959 1760 1602 1474 1208 1021 786 688 654 573 526 409 452 566 694 746 831 914 1008 1043 821 513 214 -45 -242 -453 -723 -898 -1103 -1078 -1081 -1087 -1015 -1073 -869 -884 -720 -555 -329 -24 -63 14 -96 5 260 412 636 623 611 785 788 1001 1025 98 9 1162 1215 1404 1408 1305 1311 1120 1076 956 785 740 371 389 164 202 522 478 770 483 259 250 79 497 987 1288 1453 1283 1350 1436 1441 1804 1861 2059 2156 1969 2142 2148 2384 2652 2470 2383 1883 1739 1618 1475 1523 1134 1167 1031 816 674 274 251 162 301 387 23 -176 -345 -333 -198 -356 -363 -444 -421 -192 -226 -230 -239 -326 10 106 195 132 95 202 79 -68 -222 -45 429 788 954 1256 1426 1521 1704 1729 2053 1867 1581 1434 1367 1554 1386 1221 1165 1253 1571 1394 1425 1390 948 1288 999 1421 1568 1292 1478 1019 1053 591 693 520 302 314 116 847 1340 1792 1883 1582 1474 1821 2140 2486 2651 2167 1728 1380 1345 1811 1993 2052 2325 2231 2148 2271 2450 2831 2866 2908 2721 2623 2252 2025 2393 2667 3015 2817 2668 2588 2540 2736 2761 3275 3232 3252 3168 3112 3284 3138 3458 3716 3876 3928 3824 3928 4040 4330 4923 5226 5205 5183 5172 5510 5926 6225 6306 6020 5433 4448 3261 2118 959 -239 -1741 -3208 -4507 -5623 -6134 -6133 -5617 -4931 -4192 -3378 -2817 -2219 -1588 -817 -110 199 281 -5 -417 -652 -749 -6 79 -890 -1261 -1549 -1905 -1928 -2002 -1885 -1552 -1185 -655 -235 222 793 1424 1992 2599 2940 3081 2982 2695 2667 2771 2919 2980 2662 2146 1537 1215 1217 1374 1337 1061 790 376 250 -97 -111 5 -149 -243 -733 -936 -1395 -1810 -1781 -1762 -1500 -1716 -2039 -2318 -2398 -1907 -1592 -1422 -1900 -2619 -3034 -3024 -2335 -1429 -557 323 1051 1587 2021 2282 2438 2207 1843 1789 1482 1392 1056 742 1220 1294 1464 1641 1731 1847 1291 1682 1970 2097 2253 1624 1474 1312 1312 1873 2315 2523 2486 2323 2385 2924 3638 4341 4431 4045 3644 2945 2939 2935 2867 3411 2886 2731 2211 1405 1001 640 1077 1430 1688 1803 1857 2036 2447 3394 3628 3702 3468 3361 3782 3668 3672 4050 3895 4188 4564 4217 3965 2693 1946 1878 2245 3152 3267 3120 2670 2675 3308 4567 5358 5556 5114 3953 3653 3658 4111 4688 4262 3819 3732 4224 4771 5579 5622 5585 5613 5501 5593 5452 5570 5632 6094 5985 5579 4982 4206 3878 3683 3274 2172 698 -1224 -2821 -3890 -4742 -5518 -6463 -7297 -7730 -8054 -7991 -7508 -6683 -5163 -3562 -2162 -1401 -1000 -650 -255 344 643 475 -347 -1530 -2545 -3189 -3506 -3525 -3563 -3239 -2710 -1975 -1174 -649 117 1250 2603 3929 4750 4920 4876 4692 4897 5263 5455 5008 4285 3535 2650 2480 2198 1908 1831 1412 1060 602 80 -281 -245 -37 518 694 559 449 134 264 395 501 454 294 14 -188 -258 -603 -471 -526 -212 202 413 643 447 674 1151 2015 2779 2830 2783 2349 2213 2223 1805 1467 750 640 762 709 685 202 48 360 1103 1707 1935 1604 992 986 883 1293 1285 840 880 25 72 -201 -568 -194 -266 416 698 748 1106 930 1391 2268 2672 3350 3207 3010 3183 2888 3077 3048 2737 2684 2102 1594 1047 146 -39 -397 -420 -237 -520 -465 -526 -247 398 929 1605 2176 2568 2979 3102 3165 3206 3205 3315 3167 2841 2330 1660 1172 909 881 992 1021 1063 1098 1184 1407 1681 1927 2245 2498 2652 2755 2740 2720 2600 2599 2547 2529 2425 2327 2216 1983 1798 1578 1501 1596 1707 1778 1775 1794 1832 1945 2157 2368 2534 2679 2726 2647 2546 2482 2500 2613 2715 2858 2909 2875 2798 2847 3002 3238 3544 3763 3906 3870 3762 3684 3570 3510 3375 3115 2665 2099 1534 1114 848 744 650 462 329 147 161 282 430 614 681 701 635 505 263 -31 -284 -523 -787 -1040 -1310 -1530 -1694 -1726 -1660 -1541 -1319 -1101 -872 -661 -468 -289 -53 235 439 581 607 542 488 496 442 476 539 528 480 404 353 383 409 514 643 801 911 1039 1099 1060 1002 1008 1079 1079 1088 1043 998 953 947 1077 1232 1417 1630 1737 1807 1861 1947 2139 2352 2521 2494 2388 2251 2163 2142 2183 2246 2312 2333 2215 2167 2080 1954 1856 1767 1725 1685 1560 1366 1157 915 754 677 570 434 268 50 -48 -106 -80 23 -6 3 -105 -143 -106 -86 -10 15 72 129 151 224 269 377 540 615 755 802 841 986 1126 1263 1430 1501 1565 1592 1629 1704 1769 1780 1815 1868 1875 1853 1767 1657 1676 1777 1954 2063 2033 2006 1997 2052 2132 2218 2192 2163 2068 1935 1832 1731 1692 1644 1603 1587 1656 1704 1735 1707 1693 1778 1855 1886 1808 1854 1866 2020 2082 2051 2063 1922 1994 2055 1979 1867 1654 1725 1958 2103 2250 2210 2181 2136 1990 1769 1538 1555 1690 1847 1927 1833 1861 1845 1916 1901 1878 1827 1965 2079 2011 1813 14 42 1294 1314 1438 1527 1471 1351 1346 1433 1541 1742 1882 2055 2187 2137 2094 2026 2216 2547 2788 2910 2700 2476 2276 2271 2219 2140 2106 1948 1839 1563 1271 991 871 785 695 490 237 93 101 302 452 541 637 735 773 731 667 554 479 381 262 -30 -313 -571 -871 -940 -1094 -1156 -946 -946 -789 -822 -1016 -846 -729 -380 -130 -174 -291 -393 -459 -370 -385 -488 -235 -189 -29 66 20 251 506 931 1376 1399 1348 1192 940 1022 839 916 1173 1247 1303 1207 950 888 944 1151 1385 1216 1012 762 741 964 995 1072 1129 1201 1243 1189 1214 1209 1090 1188 1226 962 840 480 309 201 8 -27 -108 19 120 122 175 188 247 298 326 490 659 638 530 299 294 391 561 749 632 677 592 520 445 175 452 195 476 279 54 216 -444 -153 -497 -42 65 -76 89 -307 613 424 736 729 692 1203 923 1051 761 782 993 912 1361 971 671 640 713 1230 870 821 292 243 774 1172 1686 1286 1348 1303 1523 1622 1578 1833 1810 1913 1658 1535 1352 1375 1673 2156 2537 2408 2275 2078 2090 2117 2030 2120 2227 2296 2388 2667 2966 3152 3134 2987 2799 2665 2686 2 666 2584 2637 2572 2631 2836 3106 3325 3066 2882 2869 3046 3325 3369 3339 3398 3350 3293 3457 3587 3759 3999 4191 4413 4437 4477 4519 4628 4905 5061 5239 5014 4922 5179 5616 6008 6053 5515 4650 3634 2615 2101 1403 430 -981 -2592 -4097 -5331 -6002 -6365 -6339 -5996 -5552 -4825 -4058 -3378 -2538 -1678 -858 -70 377 250 -342 -1019 -1354 -1355 -1196 -1361 -1521 -1624 -1862 -1561 -1109 -638 -510 -705 -845 -1026 -585 -35 768 1668 2308 2850 3002 3103 3216 3453 3876 4335 4501 4065 3249 2233 1669 1518 1717 1688 1115 370 -493 -662 -599 -225 85 -153 -466 -954 -1270 -1132 -935 -978 -1481 -2039 -2683 -3353 -3678 -3673 -3362 -2780 -2386 -2281 -2137 -2034 -1498 -801 -239 351 480 608 886 1176 1592 1788 2106 2205 2010 1893 1582 1539 1597 1795 1990 2158 2092 1255 800 1029 1404 1884 2085 1537 1103 919 870 2111 3220 3367 3480 2671 2319 2914 3620 4073 3498 2841 2067 1810 2225 2669 3168 2603 1347 499 729 1563 2063 1953 1175 432 458 1393 2521 3149 3279 2822 2467 2697 3005 3756 4386 4418 4555 3662 3241 3320 3520 3914 4087 3923 2896 2532 1732 1807 2221 2972 3933 3101 2464 1657 1615 2639 3948 4718 5026 4305 3909 3815 3811 4014 3853 4090 4153 4670 4783 4527 4113 4296 4866 5695 6258 6024 5748 5089 5020 5101 4974 4353 3499 2056 779 -738 -2628 -4028 -5515 -6213 -6815 -7376 -7953 -8558 -8565 -7680 -6158 -4573 -3152 -2390 -1579 -792 -128 414 470 360 165 -390 -1164 -2225 -3460 -4085 -4255 -3862 -3277 -2975 -2731 -2390 -1656 -387 1008 2146 3014 3428 3832 4526 4822 4875 4472 3941 3954 3945 3710 2856 1848 931 619 1054 1206 877 318 -270 -412 34 160 399 532 402 655 568 472 246 -92 356 716 776 540 -331 -730 -548 -242 338 202 -72 4 -6 637 885 1005 1330 1619 2174 2350 2069 1709 1412 1476 1747 1558 1230 711 321 398 293 313 92 81 454 659 806 581 346 351 585 870 851 436 -76 -479 -756 -907 -1190 -1414 -1586 -1628 -1483 -1389 -1238 -816 -177 556 1249 1735 2074 2385 2710 3065 3264 3285 3143 2928 2692 2297 1832 1387 1022 955 1088 1101 1028 872 870 1090 1475 1976 2316 2578 2716 2705 2557 2467 2367 2328 2364 2 301 2073 1686 1366 1175 1116 1199 1196 1109 962 920 934 983 1051 1258 1536 1752 1836 1770 1680 1643 1800 1954 2082 2111 1986 1885 1813 1824 1898 2088 2236 2353 2399 2340 2255 2213 2244 2350 2365 2326 2266 2154 2072 2068 2093 2130 2223 2295 2394 2515 2449 2426 2527 2778 3021 3240 3286 3216 3108 3004 3042 3106 3147 2990 2690 2282 1902 1641 1457 1359 1172 825 473 189 106 166 377 569 634 551 403 364 415 437 366 107 -242 -524 -723 -824 -959 -1100 -1264 -1381 -1408 -1252 -1072 -932 -889 -819 -581 -341 -107 56 128 156 158 185 260 284 270 324 376 391 423 449 446 429 521 569 566 584 546 589 624 594 594 584 607 725 876 976 1004 1046 1082 1193 1341 1372 1434 1446 1409 1528 1618 1747 1911 1985 2090 2092 2110 2170 2230 2360 2411 2433 2402 2317 2280 2227 2126 2017 1878 1729 1564 1406 1237 1073 957 906 841 788 706 548 437 429 449 554 653 664 582 500 486 511 519 430 339 318 294 287 265 288 299 429 605 681 822 808 887 950 1042 1240 1348 1547 1638 1752 1787 1765 1864 1949 2025 2058 1990 1921 1818 170 7 1755 1810 2007 2069 2017 1840 1623 1633 1646 1803 1962 2002 1985 1838 1694 1588 1493 1551 1685 1756 1784 1604 1458 1532 1660 1898 1986 1737 1551 1457 1665 1890 2078 2066 2082 2181 2156 2167 2174 2290 2341 2314 2302 2134 2114 2054 2020 2109 1974 1916 1841 1628 1718 1718 1860 1951 1774 1893 1745 1701 1769 1541 1733 1542 1509 1547 1370 1640 1572 1480 1679 1501 1747 1697 1748 1973 1763 1949 1795 2000 2185 2249 2600 2532 2713 2672 2558 2572 2506 2691 2760 2797 2680 2299 1992 1796 1558 1444 1055 663 489 6 -197 -508 -713 -632 -763 -579 -532 -472 -253 -174 -66 75 -39 72 208 312 339 87 16 -170 -198 -166 -227 -270 -498 -495 -406 -544 -569 -766 -656 -500 -344 -121 -161 -67 -60 97 96 47 31 -76 163 173 417 465 257 332 5 48 -14 -135 124 -51 17 -190 -361 -127 -23 352 410 491 632 489 608 746 1100 1463 1473 1668 1380 1289 1319 1575 1979 1935 1824 1385 1265 1351 1528 1675 1429 1018 548 133 -254 -466 -736 -796 -815 -994 -916 -948 -584 -366 -196 -132 -119 -108 -165 12 -235 -107 -353 -349 -579 -765 -9 53 -1235 -888 -764 -286 -769 -804 -787 -508 255 127 169 -177 -373 -111). - ! Item was removed: - ----- Method: RepeatingSound class>>repeat:count: (in category 'instance creation') ----- - repeat: aSound count: anInteger - "Return a RepeatingSound that will repeat the given sound for the given number of iterations." - - ^ self new setSound: aSound iterations: anInteger - ! Item was removed: - ----- Method: RepeatingSound class>>repeatForever: (in category 'instance creation') ----- - repeatForever: aSound - "Return a RepeatingSound that will repeat the given sound forever." - - ^ self new setSound: aSound iterations: #forever - ! Item was removed: - ----- Method: RepeatingSound>>copySound (in category 'copying') ----- - copySound - "Private!! Support for copying. Copy my component sound." - - sound := sound copy. - ! Item was removed: - ----- Method: RepeatingSound>>doControl (in category 'sound generation') ----- - doControl - - super doControl. - sound doControl. - ! Item was removed: - ----- Method: RepeatingSound>>iterationCount (in category 'accessing') ----- - iterationCount - - ^ iterationCount - ! Item was removed: - ----- Method: RepeatingSound>>iterationCount: (in category 'accessing') ----- - iterationCount: aNumber - - iterationCount := aNumber. - ! Item was removed: - ----- Method: RepeatingSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play a collection of sounds in sequence." - "(RepeatingSound new - setSound: FMSound majorScale - iterations: 2) play" - - | i count samplesNeeded | - iteration <= 0 ifTrue: [^ self]. - i := startIndex. - samplesNeeded := n. - [samplesNeeded > 0] whileTrue: [ - count := sound samplesRemaining min: samplesNeeded. - count = 0 ifTrue: [ - iterationCount == #forever - ifFalse: [ - iteration := iteration - 1. - iteration <= 0 ifTrue: [^ self]]. "done" - sound reset. - count := sound samplesRemaining min: samplesNeeded. - count = 0 ifTrue: [^ self]]. "zero length sound" - sound mixSampleCount: count - into: aSoundBuffer - startingAt: i - leftVol: leftVol * scaledVol // ScaleFactor - rightVol: rightVol * scaledVol // ScaleFactor. - i := i + count. - samplesNeeded := samplesNeeded - count]. - ! Item was removed: - ----- Method: RepeatingSound>>postCopy (in category 'copying') ----- - postCopy - "Copy my component sound." - - super postCopy. - self copySound - ! Item was removed: - ----- Method: RepeatingSound>>reset (in category 'sound generation') ----- - reset - - super reset. - sound reset. - samplesPerIteration := sound samplesRemaining. - iterationCount == #forever - ifTrue: [iteration := 1] - ifFalse: [iteration := iterationCount]. - ! Item was removed: - ----- Method: RepeatingSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - iterationCount == #forever ifTrue: [^ 1000000]. - iteration > 0 - ifTrue: [^ sound samplesRemaining + ((iteration - 1) * samplesPerIteration)] - ifFalse: [^ 0]. - ! Item was removed: - ----- Method: RepeatingSound>>setPitch:dur:loudness: (in category 'initialization') ----- - setPitch: p dur: d loudness: l - - self error: 'RepeatingSounds do not support playing notes'. - ! Item was removed: - ----- Method: RepeatingSound>>setSound:iterations: (in category 'initialization') ----- - setSound: aSound iterations: anIntegerOrSymbol - "Initialize the receiver to play the given sound the given number of times. If iteration count is the symbol #forever, then repeat indefinitely." - "(RepeatingSound repeat: AbstractSound scaleTest count: 2) play" - "(RepeatingSound repeatForever: PluckedSound lowMajorScale) play" - - super initialize. - sound := aSound. - iterationCount := anIntegerOrSymbol. - self reset. - ! Item was removed: - ----- Method: RepeatingSound>>sound (in category 'accessing') ----- - sound - - ^ sound - ! Item was removed: - ----- Method: RepeatingSound>>sound: (in category 'accessing') ----- - sound: aSound - - sound := aSound. - ! Item was removed: - AbstractSound subclass: #RestSound - instanceVariableNames: 'initialCount count' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: RestSound class>>dur: (in category 'instance creation') ----- - dur: d - "Return a rest of the given duration." - - ^ self new setDur: d - ! Item was removed: - ----- Method: RestSound class>>pitch:dur:loudness: (in category 'instance creation') ----- - pitch: p dur: d loudness: l - "Return a rest of the given duration." - "Note: This message allows one to silence one or more voices of a multi-voice piece by using RestSound as their instrument." - - ^ self new setDur: d - ! Item was removed: - ----- Method: RestSound>>duration (in category 'accessing') ----- - duration - "Answer the duration of this sound in seconds." - - ^ initialCount asFloat / self samplingRate - ! Item was removed: - ----- Method: RestSound>>duration: (in category 'accessing') ----- - duration: seconds - - super duration: seconds. - count := initialCount := (seconds * self samplingRate) rounded. - ! Item was removed: - ----- Method: RestSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play silence for a given duration." - "(RestSound dur: 1.0) play" - - count := count - n. - ! Item was removed: - ----- Method: RestSound>>reset (in category 'sound generation') ----- - reset - - super reset. - count := initialCount. - ! Item was removed: - ----- Method: RestSound>>samples (in category 'accessing') ----- - samples - ^ SoundBuffer newMonoSampleCount: initialCount! Item was removed: - ----- Method: RestSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - ^ count - ! Item was removed: - ----- Method: RestSound>>setDur: (in category 'initialization') ----- - setDur: d - "Set rest duration in seconds." - - initialCount := (d * self samplingRate asFloat) rounded. - count := initialCount. - self reset. - ! Item was removed: - AbstractSound subclass: #ReverbSound - instanceVariableNames: 'sound tapDelays tapGains tapCount bufferSize bufferIndex leftBuffer rightBuffer' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: ReverbSound>>applyReverbTo:startingAt:count: (in category 'private') ----- - applyReverbTo: aSoundBuffer startingAt: startIndex count: n - - | delayedLeft delayedRight i tapGain j out | - <primitive: 'primitiveApplyReverb' module:'SoundGenerationPlugin'> - <var: #aSoundBuffer declareC: 'short int *aSoundBuffer'> - <var: #tapDelays declareC: 'int *tapDelays'> - <var: #tapGains declareC: 'int *tapGains'> - <var: #leftBuffer declareC: 'short int *leftBuffer'> - <var: #rightBuffer declareC: 'short int *rightBuffer'> - - startIndex to: ((startIndex + n) - 1) do: [:sliceIndex | - delayedLeft := delayedRight := 0. - 1 to: tapCount do: [:tapIndex | - i := bufferIndex - (tapDelays at: tapIndex). - i < 1 ifTrue: [i := i + bufferSize]. "wrap" - tapGain := tapGains at: tapIndex. - delayedLeft := delayedLeft + (tapGain * (leftBuffer at: i)). - delayedRight := delayedRight + (tapGain * (rightBuffer at: i))]. - - "left channel" - j := (2 * sliceIndex) - 1. - out := (aSoundBuffer at: j) + (delayedLeft // ScaleFactor). - out > 32767 ifTrue: [out := 32767]. "clipping!!" - out < -32767 ifTrue: [out := -32767]. "clipping!!" - aSoundBuffer at: j put: out. - leftBuffer at: bufferIndex put: out. - - "right channel" - j := j + 1. - out := (aSoundBuffer at: j) + (delayedRight // ScaleFactor). - out > 32767 ifTrue: [out := 32767]. "clipping!!" - out < -32767 ifTrue: [out := -32767]. "clipping!!" - aSoundBuffer at: j put: out. - rightBuffer at: bufferIndex put: out. - - bufferIndex := (bufferIndex \\ bufferSize) + 1]. - ! Item was removed: - ----- Method: ReverbSound>>copySound (in category 'copying') ----- - copySound - "Private!! Support for copying. Copy my component sound." - - sound := sound copy. - leftBuffer := leftBuffer shallowCopy. - rightBuffer := rightBuffer shallowCopy. - ! Item was removed: - ----- Method: ReverbSound>>doControl (in category 'sound generation') ----- - doControl - - super doControl. - sound doControl. - ! Item was removed: - ----- Method: ReverbSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play my sound with reverberation." - - sound mixSampleCount: n - into: aSoundBuffer - startingAt: startIndex - leftVol: leftVol - rightVol: rightVol. - self applyReverbTo: aSoundBuffer startingAt: startIndex count: n. - ! Item was removed: - ----- Method: ReverbSound>>postCopy (in category 'copying') ----- - postCopy - "Copy my component sound." - - super postCopy. - self copySound - ! Item was removed: - ----- Method: ReverbSound>>reset (in category 'sound generation') ----- - reset - - super reset. - sound reset. - 1 to: bufferSize do: [:i | - leftBuffer at: i put: 0. - rightBuffer at: i put: 0]. - ! Item was removed: - ----- Method: ReverbSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - ^ sound samplesRemaining - ! Item was removed: - ----- Method: ReverbSound>>sound (in category 'accessing') ----- - sound - - ^ sound - ! Item was removed: - ----- Method: ReverbSound>>sound: (in category 'accessing') ----- - sound: aSound - - sound := aSound. - ! Item was removed: - ----- Method: ReverbSound>>tapDelays:gains: (in category 'accessing') ----- - tapDelays: delayList gains: gainList - "ReverbSound new tapDelays: #(537 691 1191) gains: #(0.07 0.07 0.07)" - - | maxDelay gain d | - delayList size = gainList size - ifFalse: [self error: 'tap delay and gains lists must be the same size']. - tapCount := delayList size. - tapDelays := Bitmap new: tapCount. - tapGains := Bitmap new: tapCount. - - maxDelay := 0. - 1 to: tapGains size do: [:i | - tapDelays at: i put: (delayList at: i) asInteger. - gain := gainList at: i. - gain >= 1.0 ifTrue: [self error: 'reverb tap gains must be under 1.0']. - tapGains at: i put: (gain * ScaleFactor) asInteger. - d := tapDelays at: i. - d > maxDelay ifTrue: [maxDelay := d]]. - bufferSize := maxDelay. - leftBuffer := SoundBuffer newMonoSampleCount: maxDelay. - rightBuffer := SoundBuffer newMonoSampleCount: maxDelay. - bufferIndex := 1. - ! Item was removed: - Object subclass: #SampledInstrument - instanceVariableNames: 'sustainedSoft sustainedLoud staccatoSoft staccatoLoud sustainedThreshold loudThreshold' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !SampledInstrument commentStamp: '<historical>' prior: 0! - I represent a collection of individual notes at different pitches, volumes, and articulations. On request, I can select the best note to use for a given pitch, duration, and volume. I currently only support two volumes, loud and soft, and two articulations, normal and staccato, but I can easily be extended to include more. The main barrier to keeping more variations is simply the memory space (assuming my component notes are sampled sounds). - ! Item was removed: - ----- Method: SampledInstrument class>>buildSmallOrchestra (in category 'instance creation') ----- - buildSmallOrchestra - "Example of how to build a skeleton orchestra that uses less memory (about 14 MBytes)." - "SampledInstrument buildSmallOrchestra" - - | dir | - AbstractSound unloadSampledTimbres. - dir := 'Tosh:Not Backed Up:Sample Library:Orchestra'. - #(clarinet oboe bassoon trombone tympani) do: [:instName | - SampledInstrument - readSimpleInstrument: instName - fromDirectory: dir. - (AbstractSound soundNamed: instName, '-f') pruneToNotesPerOctave: 1]. - #(flute bass) do: [:instName | - SampledInstrument - readSimpleInstrument: instName - fromDirectory: dir. - (AbstractSound soundNamed: instName, '-f') pruneToNotesPerOctave: 2]. - - (AbstractSound soundNamed: 'bass-f') allNotes do: [:n | - n firstSample: (n findStartPointForThreshold: 2500)]. - - (AbstractSound soundNamed: 'bassoon-f') allNotes do: [:n | - n beUnlooped. - n firstSample: (n findStartPointForThreshold: 0)]. - - (AbstractSound soundNamed: 'trombone-f') allNotes do: [:n | - n firstSample: (n findStartPointForThreshold: 1800)]. - - AbstractSound soundNamed: 'trumpet-f' put: (AbstractSound soundNamed: 'trombone-f'). - AbstractSound soundNamed: 'horn-f' put: (AbstractSound soundNamed: 'trombone-f'). - AbstractSound soundNamed: 'violin-f' put: (AbstractSound soundNamed: 'bass-f'). - AbstractSound soundNamed: 'viola-f' put: (AbstractSound soundNamed: 'bass-f'). - AbstractSound soundNamed: 'cello-f' put: (AbstractSound soundNamed: 'bass-f'). - - (AbstractSound soundNamed: 'bassoon-f') allNotes do: [:n | n beUnlooped]. - - ! Item was removed: - ----- Method: SampledInstrument class>>readLoudAndStaccatoInstrument:fromDirectory: (in category 'instance creation') ----- - readLoudAndStaccatoInstrument: instName fromDirectory: orchestraDir - "SampledInstrument - readLoudAndStaccatoInstrument: 'oboe' - fromDirectory: 'Tosh/Sample Library/Orchestra'" - | sampleSetDir memBefore memAfter loud short snd | - sampleSetDir := orchestraDir , FileDirectory slash , instName. - memBefore := Smalltalk garbageCollect. - loud := SampledInstrument new readSampleSetFrom: sampleSetDir, ' f'. - short := SampledInstrument new readSampleSetFrom: sampleSetDir, ' stacc'. - memAfter := Smalltalk garbageCollect. - Transcript show: - instName, ': ', (memBefore - memAfter) printString, - ' bytes; ', memAfter printString, ' bytes left'; cr. - AbstractSound soundNamed: instName, '-f&stacc' put: - (snd := SampledInstrument new - allSampleSets: loud; - staccatoLoudAndSoftSampleSet: short). - "fix slow attacks" - snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 500)]. - - AbstractSound soundNamed: instName, '-f' put: - (snd := SampledInstrument new - allSampleSets: loud). - "fix slow attacks" - snd allNotes do: [:n | n firstSample: (n findStartPointForThreshold: 1000)].! Item was removed: - ----- Method: SampledInstrument class>>readPizzInstrument:fromDirectory: (in category 'instance creation') ----- - readPizzInstrument: instName fromDirectory: orchestraDir - "SampledInstrument - readPizzInstrument: 'violin' - fromDirectory: 'Tosh/Sample Library/Orchestra'" - | sampleSetDir memBefore memAfter sampleSet snd | - sampleSetDir := orchestraDir , FileDirectory slash , instName , ' pizz'. - memBefore := Smalltalk garbageCollect. - sampleSet := SampledInstrument new readSampleSetFrom: sampleSetDir. - memAfter := Smalltalk garbageCollect. - Transcript show: - instName, ': ', (memBefore - memAfter) printString, - ' bytes; ', memAfter printString, ' bytes left'; cr. - AbstractSound soundNamed: instName, '-pizz' put: - (snd := SampledInstrument new allSampleSets: sampleSet). - - "fix slow attacks" - snd allNotes do: [:n | - n firstSample: (n findStartPointForThreshold: 1000)]. - - ^ snd! Item was removed: - ----- Method: SampledInstrument class>>readSimpleInstrument:fromDirectory: (in category 'instance creation') ----- - readSimpleInstrument: instName fromDirectory: orchestraDir - "SampledInstrument - readSimpleInstrument: 'oboe' - fromDirectory: 'Tosh:Sample Library:Orchestra'" - - | sampleSetDir memBefore memAfter sampleSet snd | - sampleSetDir := orchestraDir, FileDirectory slash, instName, ' f'. - memBefore := Smalltalk garbageCollect. - sampleSet := SampledInstrument new readSampleSetFrom: sampleSetDir. - memAfter := Smalltalk garbageCollect. - Transcript show: - instName, ': ', (memBefore - memAfter) printString, - ' bytes; ', memAfter printString, ' bytes left'; cr. - AbstractSound soundNamed: instName, '-f' put: - (snd := SampledInstrument new allSampleSets: sampleSet). - - "fix slow attacks" - snd allNotes do: [:n | - n firstSample: (n findStartPointForThreshold: 1000)]. - - ^ snd - ! Item was removed: - ----- Method: SampledInstrument>>allNotes (in category 'other') ----- - allNotes - "Answer a collection containing of all the unique sampled sounds used by this instrument." - - | r | - r := IdentitySet new. - r addAll: sustainedLoud. - sustainedSoft ~~ sustainedLoud ifTrue: [r addAll: sustainedSoft]. - staccatoLoud ~~ sustainedLoud ifTrue: [r addAll: staccatoLoud]. - staccatoSoft ~~ staccatoLoud ifTrue: [r addAll: staccatoSoft]. - ^ r asArray sort: [:n1 :n2 | n1 pitch < n2 pitch] - ! Item was removed: - ----- Method: SampledInstrument>>allSampleSets: (in category 'accessing') ----- - allSampleSets: sortedNotes - - | keyMap | - keyMap := self midiKeyMapFor: sortedNotes. - sustainedSoft := keyMap. - sustainedLoud := keyMap. - staccatoSoft := keyMap. - staccatoLoud := keyMap. - ! Item was removed: - ----- Method: SampledInstrument>>chooseSamplesForPitch:from: (in category 'other') ----- - chooseSamplesForPitch: pitchInHz from: sortedNotes - "From the given collection of LoopedSampledSounds, choose the best one to be pitch-shifted to produce the given pitch." - "Assume: the given collection is sorted in ascending pitch order." - - | i lower higher | - i := 1. - [(i < sortedNotes size) and: [(sortedNotes at: i) pitch < pitchInHz]] - whileTrue: [i := i + 1]. - i = 1 ifTrue: [^ sortedNotes at: 1]. - lower := sortedNotes at: i - 1. - higher := sortedNotes at: i. - "note: give slight preference for down-shifting a higher-pitched sample set" - (pitchInHz / lower pitch) < ((0.95 * higher pitch) / pitchInHz) - ifTrue: [^ lower] - ifFalse: [^ higher]. - ! Item was removed: - ----- Method: SampledInstrument>>initialize (in category 'accessing') ----- - initialize - - super initialize. - sustainedThreshold := 0.15. - loudThreshold := 0.5. - ! Item was removed: - ----- Method: SampledInstrument>>loudThreshold (in category 'accessing') ----- - loudThreshold - - ^ loudThreshold - ! Item was removed: - ----- Method: SampledInstrument>>loudThreshold: (in category 'accessing') ----- - loudThreshold: aNumber - - loudThreshold := aNumber asFloat. - ! Item was removed: - ----- Method: SampledInstrument>>memorySpace (in category 'other') ----- - memorySpace - "Answer the number of bytes required to store the samples for this instrument." - - | total | - total := 0. - self allNotes do: [:n | - total := total + (n leftSamples monoSampleCount * 2). - n isStereo ifTrue: [total := total + (n leftSamples monoSampleCount * 2)]]. - ^ total - ! Item was removed: - ----- Method: SampledInstrument>>midiKeyMapFor: (in category 'other') ----- - midiKeyMapFor: sortedNotes - "Return a 128 element array that maps each MIDI key number to the sampled note from the given set with the closests pitch. A precise match isn't necessary because the selected note will be pitch shifted to play at the correct pitch." - - ^ (0 to: 127) collect: [:k | - self - chooseSamplesForPitch: (AbstractSound pitchForMIDIKey: k) - from: sortedNotes]. - ! Item was removed: - ----- Method: SampledInstrument>>playChromaticRunFrom:to: (in category 'other') ----- - playChromaticRunFrom: startPitch to: endPitch - - (AbstractSound chromaticRunFrom: startPitch to: endPitch on: self) play. - ! Item was removed: - ----- Method: SampledInstrument>>pruneNoteList:notesPerOctave: (in category 'other') ----- - pruneNoteList: aNoteList notesPerOctave: notesPerOctave - "Return a pruned version of the given note list with only the given number of notes per octave. Assume the given notelist is in sorted order." - - | r interval lastPitch | - r := OrderedCollection new: aNoteList size. - interval := (2.0 raisedTo: (1.0 / notesPerOctave)) * 0.995. - lastPitch := 0.0. - aNoteList do: [:n | - n pitch > (lastPitch * interval) ifTrue: [ - r addLast: n. - lastPitch := n pitch]]. - ^ r - ! Item was removed: - ----- Method: SampledInstrument>>pruneToNotesPerOctave: (in category 'other') ----- - pruneToNotesPerOctave: notesPerOctave - "Prune all my keymaps to the given number of notes per octave." - - sustainedLoud := self midiKeyMapFor: - (self pruneNoteList: sustainedLoud notesPerOctave: notesPerOctave). - sustainedSoft := self midiKeyMapFor: - (self pruneNoteList: sustainedSoft notesPerOctave: notesPerOctave). - staccatoLoud := self midiKeyMapFor: - (self pruneNoteList: staccatoLoud notesPerOctave: notesPerOctave). - staccatoSoft := self midiKeyMapFor: - (self pruneNoteList: staccatoSoft notesPerOctave: notesPerOctave). - ! Item was removed: - ----- Method: SampledInstrument>>pruneToSingleNote: (in category 'other') ----- - pruneToSingleNote: aNote - "Fill all my keymaps with the given note." - - | oneNoteMap | - oneNoteMap := Array new: 128 withAll: aNote. - sustainedLoud := oneNoteMap. - sustainedSoft := oneNoteMap. - staccatoLoud := oneNoteMap. - staccatoSoft := oneNoteMap. - ! Item was removed: - ----- Method: SampledInstrument>>readSampleSetFrom: (in category 'other') ----- - readSampleSetFrom: dirName - "Answer a collection of sounds read from AIFF files in the given directory and sorted in ascending pitch order." - - | all dir | - all := OrderedCollection new. - dir := FileDirectory default on: dirName. - dir fileNames do: [:n | | fullName snd | - fullName := dir fullNameFor: n. - UIManager default - informUser: 'Reading AIFF file ', n - during: - [snd := LoopedSampledSound new - fromAIFFFileNamed: fullName - mergeIfStereo: true]. - all add: snd]. - ^ all asArray sort: [:s1 :s2 | s1 pitch < s2 pitch] - ! Item was removed: - ----- Method: SampledInstrument>>readSampleSetInfoFrom: (in category 'other') ----- - readSampleSetInfoFrom: dirName - "MessageTally spyOn: [SampledInstrument new readSampleSetFrom: 'Tosh:Desktop Folder:AAA Squeak2.0 Beta:Organ Samples:Flute8'] timeToRun" - - | all dir | - all := OrderedCollection new. - dir := FileDirectory default on: dirName. - dir fileNames do: [:n | | info fullName | - fullName := dir fullNameFor: n. - info := AIFFFileReader new readFromFile: fullName - mergeIfStereo: false - skipDataChunk: true. - all add: n -> info]. - ^ all - ! Item was removed: - ----- Method: SampledInstrument>>soundForMidiKey:dur:loudness: (in category 'playing') ----- - soundForMidiKey: midiKey dur: d loudness: l - "Answer an initialized sound object 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)." - - | keymap note | - l >= loudThreshold - ifTrue: [ - d >= sustainedThreshold - ifTrue: [keymap := sustainedLoud] - ifFalse: [keymap := staccatoLoud]] - ifFalse: [ - d >= sustainedThreshold - ifTrue: [keymap := sustainedSoft] - ifFalse: [keymap := staccatoSoft]]. - keymap ifNil: [keymap := sustainedLoud]. - note := (keymap at: midiKey) copy. - ^ note - setPitch: (AbstractSound pitchForMIDIKey: midiKey) - dur: d - loudness: (l * note gain) - ! Item was removed: - ----- Method: SampledInstrument>>soundForPitch:dur:loudness: (in category 'playing') ----- - soundForPitch: pitchNameOrNumber dur: d loudness: l - "Answer an initialized sound object 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." - "Note: Generally, SampledInstruments are expected to be played via MIDI key numbers rather than by pitches, since finding the MIDI key for a given pitch is expensive." - - ^ self soundForMidiKey: (AbstractSound midiKeyForPitch: pitchNameOrNumber) - dur: d - loudness: l - ! Item was removed: - ----- Method: SampledInstrument>>staccatoLoudAndSoftSampleSet: (in category 'accessing') ----- - staccatoLoudAndSoftSampleSet: sortedNotes - - staccatoLoud := self midiKeyMapFor: sortedNotes. - staccatoSoft := staccatoLoud. - ! Item was removed: - ----- Method: SampledInstrument>>staccatoLoudSampleSet: (in category 'accessing') ----- - staccatoLoudSampleSet: sortedNotes - - staccatoLoud := self midiKeyMapFor: sortedNotes. - ! Item was removed: - ----- Method: SampledInstrument>>staccatoSoftSampleSet: (in category 'accessing') ----- - staccatoSoftSampleSet: sortedNotes - - staccatoSoft := self midiKeyMapFor: sortedNotes. - ! Item was removed: - ----- Method: SampledInstrument>>sustainedLoudSampleSet: (in category 'accessing') ----- - sustainedLoudSampleSet: sortedNotes - - sustainedLoud := self midiKeyMapFor: sortedNotes. - ! Item was removed: - ----- Method: SampledInstrument>>sustainedSoftSampleSet: (in category 'accessing') ----- - sustainedSoftSampleSet: sortedNotes - - sustainedSoft := self midiKeyMapFor: sortedNotes. - ! Item was removed: - ----- Method: SampledInstrument>>sustainedThreshold (in category 'accessing') ----- - sustainedThreshold - - ^ sustainedThreshold - ! Item was removed: - ----- Method: SampledInstrument>>sustainedThreshold: (in category 'accessing') ----- - sustainedThreshold: aNumber - - sustainedThreshold := aNumber asFloat. - ! Item was removed: - ----- Method: SampledInstrument>>testAtPitch: (in category 'other') ----- - testAtPitch: aPitch - "SampledInstrument testAtPitch: 'c4'" - - | pattern | - pattern := (#( - (c4 0.64 100) - (c4 0.64 200) - (c4 0.64 400) - (c4 0.64 600) - (c4 0.64 800) - (c4 1.28 1000) - (c4 1.28 400) - (c4 0.32 500) - (c4 0.32 500) - (c4 0.32 500) - (c4 0.32 500) - (c4 0.16 500) - (c4 0.16 500) - (c4 0.16 500) - (c4 0.16 500) - (c4 0.16 500) - (c4 0.08 500) - (c4 0.08 500) - (c4 0.16 500) - (c4 0.08 500) - (c4 0.08 500) - (c4 0.64 500)) - collect: [:triple | triple copy at: 1 put: aPitch; yourself]). - (AbstractSound noteSequenceOn: self from: pattern) play. - ! Item was removed: - ----- Method: SampledInstrument>>trimAttackOf:threshold: (in category 'other') ----- - trimAttackOf: sampleBuffer threshold: threshold - "Trim 'silence' off the initial attacks of the given sound buffer." - - (sustainedSoft, sustainedLoud, staccatoSoft, staccatoLoud) do: [:snd | - snd leftSamples: (self trimAttackOf: snd leftSamples threshold: threshold). - snd isStereo ifTrue: [ - snd rightSamples: - (self trimAttackOf: snd rightSamples threshold: threshold)]]. - ! Item was removed: - ----- Method: SampledInstrument>>trimAttacks: (in category 'other') ----- - trimAttacks: threshold - "Trim 'silence' off the initial attacks all my samples." - - (sustainedSoft, sustainedLoud, staccatoSoft, staccatoLoud) do: [:snd | - snd leftSamples: (self trimAttackOf: snd leftSamples threshold: threshold). - snd isStereo ifTrue: [ - snd rightSamples: - (self trimAttackOf: snd rightSamples threshold: threshold)]]. - ! Item was removed: - AbstractSound subclass: #SampledSound - instanceVariableNames: 'initialCount count samples originalSamplingRate samplesSize scaledIndex indexHighBits scaledIncrement' - classVariableNames: 'CoffeeCupClink DefaultSampleTable IncrementFractionBits IncrementScaleFactor NominalSamplePitch ScaledIndexOverflow SoundLibrary' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: SampledSound class>>addLibrarySoundNamed:fromAIFFfileNamed: (in category 'sound library') ----- - addLibrarySoundNamed: aString fromAIFFfileNamed: fileName - "Add a sound from the given AIFF file to the library." - "SampledSound - addLibrarySoundNamed: 'shutterClick' - fromAIFFfileNamed: '7.aif'" - "Add all .aif files in the current directory to the sound library: - | fileNames | - fileNames := FileDirectory default fileNamesMatching: '*.aif'. - fileNames do: [:fName | - SampledSound - addLibrarySoundNamed: (fName copyUpTo: $.) - fromAIFFfileNamed: fName]" - - | snd | - snd := self fromAIFFfileNamed: fileName. - self addLibrarySoundNamed: aString - samples: snd samples - samplingRate: snd originalSamplingRate. - ! Item was removed: - ----- Method: SampledSound class>>addLibrarySoundNamed:samples:samplingRate: (in category 'sound library') ----- - addLibrarySoundNamed: aString samples: sampleData samplingRate: samplesPerSecond - "Add the given sound to the sound library. The sample data may be either a ByteArray or a SoundBuffer. If the former, it is take to be 8-bit unsigned samples. If the latter, it is taken to be 16 bit signed samples." - - SoundLibrary - at: aString - put: (Array with: sampleData with: samplesPerSecond). - ! Item was removed: - ----- Method: SampledSound class>>assimilateSoundsFrom: (in category 'sound library') ----- - assimilateSoundsFrom: aDictionary - "assimilate sounds with new keys from the given dictionary" - - aDictionary associationsDo: - [:assoc | (SoundLibrary includesKey: assoc key) ifFalse: - [SoundLibrary add: assoc]]! Item was removed: - ----- Method: SampledSound class>>beep (in category 'instance creation') ----- - beep - "Beep in the presence of the sound system. - Not to be used directly - use Beeper class>>beep - or Beeper class>>beepPrimitive instead." - - (self new - setSamples: self coffeeCupClink - samplingRate: 12000) play - ! Item was removed: - ----- Method: SampledSound class>>coffeeCupClink (in category 'coffee cup clink') ----- - coffeeCupClink - "Return the samples array for the sound of a spoon being tapped against a coffee cup." - - CoffeeCupClink ifNil: [self initializeCoffeeCupClink]. - ^ CoffeeCupClink - ! Item was removed: - ----- Method: SampledSound class>>convert8bitSignedFrom:to16Bit: (in category 'utilities') ----- - convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer - "Copy the contents of the given array of signed 8-bit samples into the given array of 16-bit signed samples." - - | n s | - <primitive: 'primitiveConvert8BitSigned' module: 'MiscPrimitivePlugin'> - <var: #aByteArray declareC: 'unsigned char *aByteArray'> - <var: #aSoundBuffer declareC: 'unsigned short *aSoundBuffer'> - n := aByteArray size. - 1 to: n do: [:i | - s := aByteArray at: i. - s > 127 - ifTrue: [aSoundBuffer at: i put: ((s - 256) bitShift: 8)] - ifFalse: [aSoundBuffer at: i put: (s bitShift: 8)]]. - ! Item was removed: - ----- Method: SampledSound class>>convert8bitSignedTo16Bit: (in category 'utilities') ----- - convert8bitSignedTo16Bit: aByteArray - "Convert the given array of samples--assumed to be 8-bit signed, linear data--into 16-bit signed samples. Return an array containing the resulting samples. Typically used to read uncompressed AIFF sound data." - - | result | - result := SoundBuffer newMonoSampleCount: aByteArray size. - self convert8bitSignedFrom: aByteArray to16Bit: result. - ^ result - ! Item was removed: - ----- Method: SampledSound class>>convert8bitUnsignedTo16Bit: (in category 'utilities') ----- - convert8bitUnsignedTo16Bit: anArray - "Convert the given array of samples--assumed to be 8-bit unsigned, linear data--into 16-bit signed samples. Return an array containing the resulting samples. Typically used to read uncompressed WAVE sound data." - - | n samples s | - n := anArray size. - samples := SoundBuffer newMonoSampleCount: n. - 1 to: n do: [:i | - s := anArray at: i. - samples at: i put: (s - 128 * 256)]. - ^ samples - ! Item was removed: - ----- Method: SampledSound class>>convertBytesTo16BitSamples:mostSignificantByteFirst: (in category 'utilities') ----- - convertBytesTo16BitSamples: aByteArray mostSignificantByteFirst: msbFirst - "Convert the given ByteArray (with the given byte ordering) into 16-bit sample buffer." - - | n data src b1 b2 w | - n := aByteArray size // 2. - data := SoundBuffer newMonoSampleCount: n. - src := 1. - 1 to: n do: [:i | - b1 := aByteArray at: src. - b2 := aByteArray at: src + 1. - msbFirst - ifTrue: [w := (b1 bitShift: 8) + b2] - ifFalse: [w := (b2 bitShift: 8) + b1]. - w > 32767 ifTrue: [w := w - 65536]. - data at: i put: w. - src := src + 2]. - ^ data - ! Item was removed: - ----- Method: SampledSound class>>defaultSampleTable: (in category 'default sound') ----- - defaultSampleTable: anArray - "Set the sample table to be used as the default waveform for playing a score such as the Bach fugue. Array is assumed to contain monaural signed 16-bit sample values." - - DefaultSampleTable := SoundBuffer fromArray: anArray. - ! Item was removed: - ----- Method: SampledSound class>>defaultSamples:repeated: (in category 'default sound') ----- - defaultSamples: anArray repeated: n - - | data | - data := WriteStream on: (SoundBuffer newMonoSampleCount: anArray size * n). - n timesRepeat: [ - anArray do: [:sample | data nextPut: sample truncated]]. - DefaultSampleTable := data contents. - ! Item was removed: - ----- Method: SampledSound class>>fileReaderServicesForFile:suffix: (in category 'file reader services') ----- - fileReaderServicesForFile: fullName suffix: suffix - - ^ (suffix = 'wav') - ifTrue: [Array with: self serviceLoadingWav] - ifFalse: [#()]! Item was removed: - ----- Method: SampledSound class>>fromAIFFfileNamed: (in category 'instance creation') ----- - fromAIFFfileNamed: fileName - "Read a SampledSound from the AIFF file of the given name, merging stereo to mono if necessary." - "(SampledSound fromAIFFfileNamed: '1.aif') play" - "| snd | - FileDirectory default fileNames do: [:n | - (n endsWith: '.aif') - ifTrue: [ - snd := SampledSound fromAIFFfileNamed: n. - snd play. - SoundPlayer waitUntilDonePlaying: snd]]." - - | aiffFileReader | - aiffFileReader := AIFFFileReader new. - aiffFileReader readFromFile: fileName - mergeIfStereo: true - skipDataChunk: false. - ^ self - samples: (aiffFileReader channelData at: 1) - samplingRate: aiffFileReader samplingRate - ! Item was removed: - ----- Method: SampledSound class>>fromDroppedWaveFileNamed: (in category 'file reader services') ----- - fromDroppedWaveFileNamed: fileName - - (self fromWaveFileNamed: fileName) explore! Item was removed: - ----- Method: SampledSound class>>fromWaveFileNamed: (in category 'instance creation') ----- - fromWaveFileNamed: fileName - "(SampledSound fromWaveFileNamed: 'c:\windows\media\chimes.wav') play" - "| snd fd | - fd := FileDirectory on:'c:\windows\media\'. - fd fileNames do: [:n | - (n asLowercase endsWith: '.wav') - ifTrue: [ - snd := SampledSound fromWaveFileNamed: (fd pathName,n). - snd play. - SoundPlayer waitUntilDonePlaying: snd]]." - - ^self fromWaveStream: (FileStream oldFileNamed: fileName) - ! Item was removed: - ----- Method: SampledSound class>>fromWaveStream: (in category 'instance creation') ----- - fromWaveStream: fileStream - - | stream header data type channels samplingRate blockAlign bitsPerSample leftAndRight | - header := self readWaveChunk: 'fmt ' inRIFF: fileStream. - data := self readWaveChunk: 'data' inRIFF: fileStream. - fileStream close. - stream := ReadStream on: header. - type := self next16BitWord: false from: stream. - type = 1 ifFalse: [^ self error:'Unexpected wave format']. - channels := self next16BitWord: false from: stream. - (channels < 1 or: [channels > 2]) - ifTrue: [^ self error: 'Unexpected number of wave channels']. - samplingRate := self next32BitWord: false from: stream. - stream skip: 4. "skip average bytes per second" - blockAlign := self next16BitWord: false from: stream. - bitsPerSample := self next16BitWord: false from: stream. - (bitsPerSample = 8 or: [bitsPerSample = 16]) - ifFalse: [ "recompute bits per sample" - bitsPerSample := (blockAlign // channels) * 8]. - - bitsPerSample = 8 - ifTrue: [data := self convert8bitUnsignedTo16Bit: data] - ifFalse: [data := self convertBytesTo16BitSamples: data mostSignificantByteFirst: false]. - - channels = 2 ifTrue: [ - leftAndRight := data splitStereo. - ^ MixedSound new - add: (self samples: leftAndRight first samplingRate: samplingRate) pan: 0.0; - add: (self samples: leftAndRight last samplingRate: samplingRate) pan: 1.0; - yourself]. - - ^ self samples: data samplingRate: samplingRate - ! Item was removed: - ----- Method: SampledSound class>>initialize (in category 'class initialization') ----- - initialize - "SampledSound initialize" - - IncrementFractionBits := 16. - IncrementScaleFactor := 2 raisedTo: IncrementFractionBits. - ScaledIndexOverflow := 2 raisedTo: 29. "handle overflow before needing LargePositiveIntegers" - self useCoffeeCupClink. - SoundLibrary ifNil: [SoundLibrary := Dictionary new]. - Beeper setDefault: (self new - setSamples: self coffeeCupClink - samplingRate: 12000). - - FileServices registerFileReader: self - ! Item was removed: - ----- Method: SampledSound class>>initializeCoffeeCupClink (in category 'coffee cup clink') ----- - initializeCoffeeCupClink - "Initialize the samples array for the sound of a spoon being tapped against a coffee cup." - "SampledSound initializeCoffeeCupClink" - - | samples | - samples := #(768 1024 -256 2304 -13312 26624 32512 19200 6400 -256 5888 32512 28928 32512 -32768 32512 -32768 18688 26368 -26112 32512 32512 2304 32512 5632 2816 10240 -4608 -1792 32512 32512 -5376 10752 32512 32512 32512 8192 15872 32512 -3584 -32768 -23296 -24832 -32768 -32768 -32768 -2304 32512 32512 -32768 32512 -15360 6400 8448 -18176 -32768 -256 -32768 -29440 9472 20992 17920 32512 32512 -256 32512 -32768 -32768 -23040 -32768 -25088 -32768 -27648 -1536 24320 -32768 32512 20480 27904 22016 16384 -32768 32512 -27648 -32768 -7168 28160 -6400 5376 32512 -256 32512 -7168 -11776 -19456 -27392 -24576 -32768 -24064 -19456 12800 32512 27136 2048 25344 15616 8192 -4608 -28672 -32768 -30464 -2560 17664 256 -8192 8448 32512 27648 -6144 -512 -7424 -18688 7936 -256 -22272 -14080 2048 27648 15616 -12288 -768 5376 3328 5632 3072 -6656 -20480 10240 27136 -10752 -11008 -768 -2048 6144 -7168 -3584 -1024 -7680 19712 26112 1024 -11008 3072 16384 -8960 -14848 -4864 -23808 -11264 12288 8192 7168 4 864 23040 32512 512 -11776 -5632 -16896 -21504 -12800 -6144 -16896 -4352 32512 32512 23296 21760 5632 2816 -9472 -20992 -11264 -29440 -32768 -3584 7680 8448 15360 32512 32512 15616 15104 -2048 -27904 -27904 -25600 -12288 -12032 -13568 17152 22272 15360 30208 28160 7680 -5632 -8192 -16384 -31744 -25856 -10752 -3840 6656 13056 24320 26368 12800 20736 12288 -19200 -20992 -16640 -21504 -17920 -6912 8448 11264 14080 23040 18176 8192 -1024 0 256 -20992 -19712 -4608 -11264 -2048 14080 12032 8192 6912 13056 9216 -5632 -5376 -3840 -6656 -9984 -5632 4864 -3584 -1280 17408 7680 -1280 4096 2816 -1024 -4864 3328 8448 -768 -5888 -2048 5120 0 3072 11008 -7680 -15360 2560 6656 -3840 0 11776 7680 2816 1536 -1280 -3840 -8704 -1536 3584 -9728 -9728 11776 18688 7680 6656 6400 -4864 -3840 -256 -6912 -13312 -11264 2304 9728 1792 3328 18944 18432 6912 6144 -1536 -17664 -14336 -2304 -10496 -15616 -4096 9728 17152 14848 13312 11520 2304 -1024 2560 -8704 -26624 -18688 -256 -256 2816 14080 13824 12544 14080 9 728 -512 -12032 -8960 -3328 -9984 -15872 -5120 8192 3584 10496 20224 7936 4608 6144 1280 -8704 -12800 -7424 -8448 -8960 -3840 7424 13056 8704 13312 13056 -2304 -4864 -768 -7168 -10496 -4608 -1536 -3072 -1280 6144 13312 11008 4864 4864 1536 -8960 -7680 1792 -4864 -7680 2816 5632 3328 2560 5376 7936 3584 -512 512 -4608 -9728 0 9216 768 -4096 7680 7168 256 4608 -768 -8704 -6400 2048 6144 -3072 -3328 6400 9472 3840 -768 1792 -3840 -5120 6144 768 -9984 -4352 5120 9472 6912 2816 1792 1280 768 512 -2816 -9728 -6912 6912 6912 -3328 -768 8448 11776 10752 3328 -6912 -10752 -8704 -1536 0 -6912 -3328 9984 13568 7424 6144 6656 256 0 256 -12032 -17920 -8192 3584 8960 4096 5632 12032 8704 6912 5632 -3584 -10496 -7936 -2048 -9216 -11776 2304 9472 15104 14848 5888 512 -2816 1024 2560 -9984 -13312 -5120 768 1792 768 8448 12032 11264 12800 -256 -11264 -9728 -2304 3072 -4352 -6912 256 2304 5376 9984 8192 2816 1280 3584 -2048 -11008 -8448 -2048 3072 4864 2304 3072 3072 3072 7168 3328 -5376 -4864 512 512 -1792 -1792 1792 5376 5888 5888 512 -5888 -3584 4096 3584 -6400 -4864 4608 3072 3840 5376 1024 768 2816 5888 -768 -12288 -7936 2304 5888 3328 2048 6144 3072 3072 6400 -3328 -7168 256 4096 -512 -9472 -6656 3328 6912 9216 8704 3840 -2560 -256 6656 -2560 -11264 -4608 -768 -1280 1536 3072 4096 5120 9984 11264 1024 -8192 -6144 -1024 -3840 -5632 -512 1024 2304 9728 9728 1280 512 4096 2816 -3584 -9984 -6912 -2304 512 5632 7680 3584 1024 5632 5888 -1280 -3584 -2304 -2560 -1536 -1024 -1792 -512 1536 7680 9984 2048 -2048 2048 3328 -1280 -4096 -3328 -4608 -1280 4352 3328 1280 1792 5120 6912 1024 -2560 0 -768 -1024 1280 -256 -4608 -1280 6400 5120 768 1792 2560 2048 0 -1536 -1280 -2304 1024 5376 2560 -2560 -512 4096 2048 512 768 -1280 -256 2560 2560 -256 -1024 768 3584 1280 -3328 -1536 1792 2816 3328 2304 -256 256 2816 2304 -1280 -3328 -1536 2304 2304 -256 -256 1024 1536 3840 5120 1024 -2048 0 1536 -768 -2560 -1792 256 2304 2048 1536 256 768 5888 6656 256 -3840 -2304 -1280 -1536 256 0 -512 2304 4352 3840 768 0 2304 3072 256 -3072 -2560 -2560 256 4608 2560 256 1536 3072 3072 1792 256 256 512 -256 -768 -1280 -1536 768 4352 2816 -512 768 2560 2560 2304 -256 -1792 -768 768 1792 256 -2304 -256 3328 3840 2304 2304 1536 256 2048 1024 -1536 -1792 -1024 512 256 -512 0 2304 4864 5120 4352 1024 -1280 0 -768 -2816 -2304 -512 1024 2048 2304 2048 3072 3840 2816 2048 -512 -3072 -1792 -1536 -1280 768 1280 1536 2304 2816 2048 1536 2048 1536 1536 -768 -3840 -2048 0 1280 2816 1792 1536 2560 3584 2816 1024 256 -768 -768 -1280 -2816 -768 1792 3328 5120 3072 1280 1536 1792 768 -1024 -1280 -1536 -768 512 256 1536 2560 2560 3328 1280 0 768 1536 768 -256 -512 -1536 -1280 768 1280 2304 2560 2560 2560 1024 -256 -512 0 1280 1536 768 -1280 -512 2048 1536 2048 1280 -256 256 512 768 768 1280 2304 1792 512 -1280 -1024 768 1536 1536 256 -768 1536 3584 3072 1792 -256 -1536 -512 256 -512 -512 768 2048 2048 1792 1280 1280 3072 2816 768 -1024 -2304 -1024 256 256 1280 1792 2304 2816 2304 1280 512 1024 768 -76 8 -1280 -1280 -512 1536 2560 2816 2048 512 1024 1792 1280 768 0 -768 -768 0 256 256 1280 2560 2304 2304 1536 512 512 1024 1280 0 -1792 -1536 -512 1280 3072 2816 1792 512 1024 1536 256 -256 768 768 256 256 -256 512 1280 1280 1536 768 1024 1792 1536 1024 0 256 -512 -256 1024 512 256 768 1792 2304 1280 256 768 1024 1280 1792 768 -768 -768 768 512 256 1024 1792 1536 1280 1536 1792 1280 768 512 -512 -1792 -512 512 768 2304 2816 1792 768 1536 2304 1536 0 -256 -256 -768 -768 256 1536 1536 2304 2048 256 768 2048 2304 1280 0 -256 -1024 -1024 0 1024 1792 2304 2304 1280 512 1280 2048 1280 256 -512 -1792 -1536 256 1536 1792 2048 2048 2048 1536 512 512 768 256 -256 0 -512 -1024 768 2048 2304 2304 1280 1280 1024 1024 1024 0 -512 256 768 0 -256 1536 2304 1792 2304 1280 -512 -256 768 1536 1024 256 512 512 1024 1792 1792 1536 1024 1280 0 -1280 256 2048 2560 2048 1024 -256 -256 1024 1280 1536 1024 0 0 256 768 1792 2304 2048 1280 1024 0 -512 -256 256 1024 1024 512 768 768 1280 2048 1792 1024 768 768 - 256 -1024 0 256 1024 1536 1024 1280 1536 1792 1792 1024 512 512 0 -512 -256 512 768 1280 1280 1024 1280 1792 1792 1280 512 -256 -256 256 512 1280 1024 1280 1280 1024 1024 768 1024 1024 1024 1280 256 256 768 768 1024 512 256 768 1280 2560 2560 1280 512 -256 -512 -256 1024 1536 768 1024 1280 768 1024 1536 1536 1024 256 0 0 0 768 768 512 1280 1536 1280 1280 1280 1280 768 768 256 -256 768 768 256 768 1280 1792 1536 1536 1536 256 512 1024 0 -768 -256 768 512 1024 2048 1536 1024 1536 1536 768 0 0 -256). - - CoffeeCupClink := SoundBuffer fromArray: samples. - ! Item was removed: - ----- Method: SampledSound class>>next16BitWord:from: (in category 'WAV reading') ----- - next16BitWord: msbFirst from: stream - "Read a 16-bit positive integer from the input stream." - "Assume: Stream has at least two bytes left." - - | n | - n := stream next: 2. - ^msbFirst - ifTrue:[(n at: 1) * 256 + (n at: 2)] - ifFalse:[(n at: 2) * 256 + (n at: 1)] - ! Item was removed: - ----- Method: SampledSound class>>next32BitWord:from: (in category 'WAV reading') ----- - next32BitWord: msbFirst from: stream - "Read a 32-bit positive integer from the input stream." - "Assume: Stream has at least four bytes left." - - | n | - n := stream next: 4. - ^msbFirst - ifTrue:[(n at: 1) * 256 + (n at: 2) * 256 + (n at: 3) * 256 + (n at: 4)] - ifFalse:[(n at: 4) * 256 + (n at: 3) * 256 + (n at: 2) * 256 + (n at: 1)] - ! Item was removed: - ----- Method: SampledSound class>>nominalSamplePitch: (in category 'default sound') ----- - nominalSamplePitch: aNumber - "Record an estimate of the normal pitch of the sampled sound." - - NominalSamplePitch := aNumber. - ! Item was removed: - ----- Method: SampledSound class>>playSoundNamed: (in category 'sound library') ----- - playSoundNamed: aString - "Play the sound with given name. Do nothing if there is no sound of that name in the library." - "SampledSound playSoundNamed: 'croak'" - - | snd | - snd := self soundNamed: aString. - snd ifNotNil: [snd play]. - ^ snd - ! Item was removed: - ----- Method: SampledSound class>>putCoffeeCupClinkInSoundLibrary (in category 'sound library') ----- - putCoffeeCupClinkInSoundLibrary - "SampledSound putCoffeeCupClinkInSoundLibrary" - - self addLibrarySoundNamed: 'clink' - samples: self coffeeCupClink - samplingRate: 11025! Item was removed: - ----- Method: SampledSound class>>readWaveChunk:inRIFF: (in category 'WAV reading') ----- - readWaveChunk: chunkType inRIFF: stream - "Search the stream for a format chunk of the given type and return its contents." - - | id count | - stream reset; binary. - stream skip: 8. "skip 'RIFF' and total length" - id := (stream next: 4) asString. "contents type" - id = 'WAVE' ifFalse: [^ '']. "content type must be WAVE" - - "search for a chunk of the given type" - [id := (stream next: 4) asString. - count := self next32BitWord: false from: stream. - id = chunkType] whileFalse: [ - "skip this chunk, rounding length up to a word boundary" - stream skip: (count + 1 bitAnd: 16rFFFFFFFE). - stream atEnd ifTrue: [^ '']]. - - ^ stream next: count "return raw chunk data" - ! Item was removed: - ----- Method: SampledSound class>>removeSoundNamed: (in category 'sound library') ----- - removeSoundNamed: aString - "Remove the sound with the given name from the sound library." - - SoundLibrary removeKey: aString ifAbsent: []. - ! Item was removed: - ----- Method: SampledSound class>>samples:samplingRate: (in category 'instance creation') ----- - samples: anArrayOf16BitSamples samplingRate: samplesPerSecond - "Return a SampledSound with the given samples array and sampling rate." - - ^ self new setSamples: anArrayOf16BitSamples samplingRate: samplesPerSecond - ! Item was removed: - ----- Method: SampledSound class>>serviceLoadingWav (in category 'file reader services') ----- - serviceLoadingWav - - ^ SimpleServiceEntry - provider: self - label: 'load as sound' - selector: #fromDroppedWaveFileNamed: - description: 'load the sound' - buttonLabel: 'load as sound'! Item was removed: - ----- Method: SampledSound class>>soundLibrary (in category 'sound library') ----- - soundLibrary - "Answer the sound library dictionary." - - ^ SoundLibrary - ! Item was removed: - ----- Method: SampledSound class>>soundNamed: (in category 'sound library') ----- - soundNamed: aString - "Answer the sound of the given name, or, if there is no sound of that name, put up an informer so stating, and answer nil" - - "(SampledSound soundNamed: 'shutterClick') play" - - ^ self soundNamed: aString ifAbsent: - [self inform: aString, ' not found in the Sound Library' translated. - nil]! Item was removed: - ----- Method: SampledSound class>>soundNamed:ifAbsent: (in category 'sound library') ----- - soundNamed: aString ifAbsent: aBlock - "Answer the sound of the given name, or if there is no sound of that name, answer the result of evaluating aBlock" - "(SampledSound soundNamed: 'shutterClick') play" - - | entry samples compressedSound | - entry := SoundLibrary - at: aString - ifAbsent: - [^ aBlock value]. - entry ifNil: [^ aBlock value]. - entry second isString - ifTrue: [compressedSound := Compiler evaluate: entry second. - compressedSound source: entry first. - ^ compressedSound asSound] - ifFalse: [samples := entry at: 1. - samples class isBytes ifTrue: [samples := self convert8bitSignedTo16Bit: samples]. - ^ self samples: samples samplingRate: (entry at: 2)] - ! Item was removed: - ----- Method: SampledSound class>>soundNames (in category 'sound library') ----- - soundNames - "Answer a list of sound names for the sounds stored in the sound library." - "SampledSound soundNames asSortedCollection do: - [:n | - (n padded: #right to: 10 with: $ ) asParagraph displayAt: Sensor cursorPoint - 32. - (SampledSound soundNamed: n) ifNotNil: - [:s| s playAndWaitUntilDone. (Delay forMilliseconds: 250) wait]]" - - ^ SoundLibrary keys asArray - ! Item was removed: - ----- Method: SampledSound class>>uLawDecode: (in category 'utilities') ----- - uLawDecode: aByteArray - "Convert the given array of uLaw-encoded 8-bit samples into a SoundBuffer of 16-bit signed samples." - - | n out decodingTable | - n := aByteArray size. - out := SoundBuffer newMonoSampleCount: n. - decodingTable := self uLawDecodeTable. - 1 to: n do: [:i | out at: i put: (decodingTable at: (aByteArray at: i) + 1)]. - ^ out - ! Item was removed: - ----- Method: SampledSound class>>uLawDecodeTable (in category 'utilities') ----- - uLawDecodeTable - "Return a 256 entry table to be used to decode 8-bit uLaw-encoded samples." - "Details: This table was computed as follows: - | d encoded lastEncodedPos lastEncodedNeg | - d := Array new: 256. - lastEncodedPos := nil. - lastEncodedNeg := nil. - 4095 to: 0 by: -1 do: [:s | - encoded := SampledSound uLawEncodeSample: s. - lastEncodedPos = encoded - ifFalse: [ - d at: (encoded + 1) put: (s bitShift: 3). - lastEncodedPos := encoded]. - encoded := encoded bitOr: 16r80. - lastEncodedNeg = encoded - ifFalse: [ - d at: (encoded + 1) put: (s bitShift: 3) negated. - lastEncodedNeg := encoded]]. - d " - - ^ #(32760 31608 30584 29560 28536 27512 26488 25464 24440 23416 22392 21368 20344 19320 18296 17272 16248 15736 15224 14712 14200 13688 13176 12664 12152 11640 11128 10616 10104 9592 9080 8568 8056 7800 7544 7288 7032 6776 6520 6264 6008 5752 5496 5240 4984 4728 4472 4216 3960 3832 3704 3576 3448 3320 3192 3064 2936 2808 2680 2552 2424 2296 2168 2040 1912 1848 1784 1720 1656 1592 1528 1464 1400 1336 1272 1208 1144 1080 1016 952 888 856 824 792 760 728 696 664 632 600 568 536 504 472 440 408 376 360 344 328 312 296 280 264 248 232 216 200 184 168 152 136 120 112 104 96 88 80 72 64 56 48 40 32 24 16 8 0 -32760 -31608 -30584 -29560 -28536 -27512 -26488 -25464 -24440 -23416 -22392 -21368 -20344 -19320 -18296 -17272 -16248 -15736 -15224 -14712 -14200 -13688 -13176 -12664 -12152 -11640 -11128 -10616 -10104 -9592 -9080 -8568 -8056 -7800 -7544 -7288 -7032 -6776 -6520 -6264 -6008 -5752 -5496 -5240 -4984 -4728 -4472 -4216 -3960 -3832 -3704 -3576 -3448 -3320 -3192 -3064 -2936 -2808 -2680 -25 52 -2424 -2296 -2168 -2040 -1912 -1848 -1784 -1720 -1656 -1592 -1528 -1464 -1400 -1336 -1272 -1208 -1144 -1080 -1016 -952 -888 -856 -824 -792 -760 -728 -696 -664 -632 -600 -568 -536 -504 -472 -440 -408 -376 -360 -344 -328 -312 -296 -280 -264 -248 -232 -216 -200 -184 -168 -152 -136 -120 -112 -104 -96 -88 -80 -72 -64 -56 -48 -40 -32 -24 -16 -8 0) - ! Item was removed: - ----- Method: SampledSound class>>uLawEncode: (in category 'utilities') ----- - uLawEncode: anArray - "Convert the given array of 16-bit signed samples into a ByteArray of uLaw-encoded 8-bit samples." - - | n out s | - n := anArray size. - out := ByteArray new: n. - 1 to: n do: [:i | - s := anArray at: i. - s := s bitShift: -3. "drop 4 least significant bits" - s < 0 - ifTrue: [s := (self uLawEncodeSample: s negated) bitOr: 16r80] - ifFalse: [s := (self uLawEncodeSample: s)]. - out at: i put: s]. - ^ out - ! Item was removed: - ----- Method: SampledSound class>>uLawEncodeSample: (in category 'utilities') ----- - uLawEncodeSample: s - "Encode the given 16-bit signed sample using the uLaw 8-bit encoding." - - s < 496 ifTrue: [ - s < 112 ifTrue: [ - s < 48 ifTrue: [ - s < 16 - ifTrue: [^ 16r70 bitOr: (15 - s)] - ifFalse: [^ 16r60 bitOr: (15 - ((s - 16) bitShift: -1))]]. - ^ 16r50 bitOr: (15 - ((s - 48) bitShift: -2))]. - s < 240 - ifTrue: [^ 16r40 bitOr: (15 - ((s - 112) bitShift: -3))] - ifFalse: [^ 16r30 bitOr: (15 - ((s - 240) bitShift: -4))]]. - - s < 2032 ifTrue: [ - s < 1008 - ifTrue: [^ 16r20 bitOr: (15 - ((s - 496) bitShift: -5))] - ifFalse: [^ 16r10 bitOr: (15 - ((s - 1008) bitShift: -6))]]. - - s < 4080 - ifTrue: [^ 15 - ((s - 2032) bitShift: -7)] - ifFalse: [^ 0]. - ! Item was removed: - ----- Method: SampledSound class>>universalSoundKeys (in category 'sound library') ----- - universalSoundKeys - "Answer a list of the sound-names that are expected to be found in the SoundLibrary of every image." - ^ {'camera' translatedNoop. 'chirp' translatedNoop. 'chomp' translatedNoop. 'click' translatedNoop. 'clink' translatedNoop. 'coyote' translatedNoop. 'croak' translatedNoop. 'horn' translatedNoop. 'laugh' translatedNoop. 'meow' translatedNoop. 'motor' translatedNoop. 'peaks' translatedNoop. 'scrape' translatedNoop. 'scratch' translatedNoop. 'scritch' translatedNoop. 'silence' translatedNoop. 'splash' translatedNoop. 'warble' translatedNoop.}! Item was removed: - ----- Method: SampledSound class>>unusedSoundNameLike: (in category 'sound library') ----- - unusedSoundNameLike: desiredName - "Pick an unused sound name based on the given string. If necessary, append digits to avoid name conflicts with existing sounds." - "SampledSound unusedSoundNameLike: 'chirp'" - - | newName i | - newName := desiredName. - i := 2. - [SoundLibrary includesKey: newName] whileTrue: [ - newName := desiredName, i printString. - i := i + 1]. - ^ newName - ! Item was removed: - ----- Method: SampledSound class>>useCoffeeCupClink (in category 'default sound') ----- - useCoffeeCupClink - "Set the sample table to be used as the default waveform to the sound of a coffee cup being tapped with a spoon." - "SampledSound useCoffeeCupClink bachFugue play" - - DefaultSampleTable := self coffeeCupClink. - NominalSamplePitch := 400. - ! Item was removed: - ----- Method: SampledSound>>compressWith: (in category 'accessing') ----- - compressWith: codecClass - | codec result | - codec := codecClass new. - result := codec compressSound: self. - codec release. - ^ result! Item was removed: - ----- Method: SampledSound>>compressWith:atRate: (in category 'accessing') ----- - compressWith: codecClass atRate: aSamplingRate - | codec result | - codec := codecClass new. - result := codec compressSound: self atRate: aSamplingRate. - codec release. - ^ result! Item was removed: - ----- Method: SampledSound>>duration (in category 'accessing') ----- - duration - - ^ initialCount asFloat / self samplingRate asFloat - ! Item was removed: - ----- Method: SampledSound>>duration: (in category 'accessing') ----- - duration: seconds - - super duration: seconds. - count := initialCount := (seconds * self samplingRate) rounded. - ! Item was removed: - ----- Method: SampledSound>>endGracefully (in category 'playing') ----- - endGracefully - "See stopGracefully, which affects initialCOunt, and I don't think it should (di)." - - | decayInMs env | - envelopes isEmpty - ifTrue: [ - self adjustVolumeTo: 0 overMSecs: 10. - decayInMs := 10] - ifFalse: [ - env := envelopes first. - decayInMs := env attackTime + env decayTime]. - count := decayInMs * self samplingRate // 1000. - ! Item was removed: - ----- Method: SampledSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'playing') ----- - 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." - - | lastIndex outIndex sampleIndex sample i s overflow | - <primitive:'primitiveMixSampledSound' module: 'SoundGenerationPlugin'> - <var: #aSoundBuffer type: #'short int *'> - <var: #samples type: #'short int *'> - - lastIndex := startIndex + n - 1. - outIndex := startIndex. "index of next stereo output sample pair" - sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). - [sampleIndex <= samplesSize and: [outIndex <= lastIndex]] whileTrue: - [sample := (samples at: sampleIndex) * scaledVol // ScaleFactor. - leftVol > 0 ifTrue: - [i := 2 * outIndex - 1. - s := (aSoundBuffer at: i) + (sample * leftVol // ScaleFactor). - "clip the result!!!!" - aSoundBuffer at: i put: (s > 32767 ifTrue: [32767] ifFalse: [s < -32767 ifTrue: [-32767] ifFalse: [s]])]. - rightVol > 0 ifTrue: - [i := 2 * outIndex. - s := (aSoundBuffer at: i) + (sample * rightVol // ScaleFactor). - "clip the result!!!!" - aSoundBuffer at: i put: (s > 32767 ifTrue: [32767] ifFalse: [s < -32767 ifTrue: [-32767] ifFalse: [s]])]. - - scaledVolIncr ~= 0 ifTrue: - [scaledVol := scaledVol + scaledVolIncr. - (scaledVolIncr > 0 - ifTrue: [scaledVol >= scaledVolLimit] - ifFalse: [scaledVol <= scaledVolLimit]) - ifTrue: "reached the limit; stop incrementing" - [scaledVol := scaledVolLimit. - scaledVolIncr := 0]]. - - scaledIndex := scaledIndex + scaledIncrement. - "In 64-bits we don't have to worry about scaled indexes overflowing, - and in the primitive this is guard evaluated at compile time." - (SmallInteger maxVal <= 16r3FFFFFFF - and: [scaledIndex >= ScaledIndexOverflow]) ifTrue: - [overflow := scaledIndex >> IncrementFractionBits. - indexHighBits := indexHighBits + overflow. - scaledIndex := scaledIndex - (overflow << IncrementFractionBits)]. - - sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). - outIndex := outIndex + 1]. - "But we still have to update indexHighBits and scaledIndex correctly outside the loop..." - SmallInteger maxVal > 16r3FFFFFFF ifTrue: - [overflow := scaledIndex >> IncrementFractionBits. - indexHighBits := indexHighBits + overflow. - scaledIndex := scaledIndex - (overflow << IncrementFractionBits)]. - count := count - n! Item was removed: - ----- Method: SampledSound>>originalSamplingRate (in category 'accessing') ----- - originalSamplingRate - - ^ originalSamplingRate - ! Item was removed: - ----- Method: SampledSound>>pitch: (in category 'initialization') ----- - pitch: pitchNameOrNumber - - | p | - p := self nameOrNumberToPitch: pitchNameOrNumber. - originalSamplingRate := - ((self samplingRate asFloat * p asFloat) / NominalSamplePitch asFloat) asInteger. - self reset. - ! Item was removed: - ----- Method: SampledSound>>playSilentlyUntil: (in category 'playing') ----- - playSilentlyUntil: startTime - "Used to fast foward to a particular starting time. - Overridden to be instant for sampled sounds." - - "true ifTrue: [^ super playSilentlyUntil: startTime]." - indexHighBits := (startTime * originalSamplingRate) asInteger. - scaledIndex := IncrementScaleFactor. - count := initialCount - (startTime * self samplingRate). - mSecsSinceStart := (startTime * 1000) asInteger. - - ! Item was removed: - ----- Method: SampledSound>>reset (in category 'playing') ----- - reset - "Details: The sample index and increment are scaled to allow fractional increments without having to do floating point arithmetic in the inner loop." - - super reset. - scaledIncrement := - ((originalSamplingRate asFloat / self samplingRate) * IncrementScaleFactor) rounded. - count := initialCount. - scaledIndex := IncrementScaleFactor. "index of the first sample, scaled" - indexHighBits := 0. - ! Item was removed: - ----- Method: SampledSound>>samples (in category 'accessing') ----- - samples - - ^ samples - ! Item was removed: - ----- Method: SampledSound>>samplesRemaining (in category 'playing') ----- - samplesRemaining - - ^ count - ! Item was removed: - ----- Method: SampledSound>>setPitch:dur:loudness: (in category 'initialization') ----- - setPitch: pitchNameOrNumber dur: d loudness: vol - "Used to play scores using the default sample table." - "(SampledSound pitch: 880.0 dur: 1.5 loudness: 0.6) play" - - | p | - super setPitch: pitchNameOrNumber dur: d loudness: vol. - p := self nameOrNumberToPitch: pitchNameOrNumber. - samples := DefaultSampleTable. - samplesSize := samples size. - initialCount := (d * self samplingRate asFloat) rounded. - originalSamplingRate := - ((self samplingRate asFloat * p asFloat) / NominalSamplePitch asFloat) asInteger. - self loudness: vol. - self reset. - ! Item was removed: - ----- Method: SampledSound>>setSamples:samplingRate: (in category 'initialization') ----- - setSamples: anArray samplingRate: rate - "Set my samples array to the given array with the given nominal sampling rate. Altering the rate parameter allows the sampled sound to be played back at different pitches." - "Note: There are two ways to use sampled sound: (a) you can play them through once (supported by this method) or (b) you can make them the default waveform with which to play a musical score (supported by the class method defaultSampleTable:)." - "Assume: anArray is either a SoundBuffer or a collection of signed 16-bit sample values." - "(SampledSound - samples: SampledSound coffeeCupClink - samplingRate: 5000) play" - - "copy the array into a SoundBuffer if necessary" - anArray class isWords - ifTrue: [samples := anArray] - ifFalse: [samples := SoundBuffer fromArray: anArray]. - - samplesSize := samples size. - samplesSize >= SmallInteger maxVal ifTrue: [ "this is unlikely..." - self error: 'sample count must be under ', SmallInteger maxVal printString]. - originalSamplingRate := rate. - initialCount := (samplesSize * self samplingRate) // originalSamplingRate. - self loudness: 1.0. - self reset. - ! Item was removed: - ----- Method: SampledSound>>setScaledIncrement: (in category 'playing') ----- - setScaledIncrement: aNumber - - scaledIncrement := (aNumber * IncrementScaleFactor) rounded. - - ! Item was removed: - ----- Method: SampledSound>>stopAfterMSecs: (in category 'playing') ----- - stopAfterMSecs: mSecs - "Terminate this sound this note after the given number of milliseconds." - - count := (mSecs * self samplingRate) // 1000. - ! Item was removed: - ----- Method: SampledSound>>storeSampleCount:bigEndian:on: (in category 'file i/o') ----- - storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream - "Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files)." - - | reverseBytes | - self samplingRate ~= originalSamplingRate ifTrue: [ - ^ super storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream]. - - "optimization: if sampling rates match, just store my buffer" - reverseBytes := bigEndianFlag ~= Smalltalk isBigEndian. - reverseBytes ifTrue: [samples reverseEndianness]. - (aBinaryStream isKindOf: StandardFileStream) - ifTrue: [ "optimization for files: write sound buffer directly to file" - aBinaryStream next: (samples size // 2) putAll: samples startingAt: 1] "size in words" - ifFalse: [ "for non-file streams:" - 1 to: samples monoSampleCount do: [:i | aBinaryStream int16: (samples at: i)]]. - reverseBytes ifTrue: [samples reverseEndianness]. "restore to original endianness" - ! Item was removed: - ----- Method: SampledSound>>volumeForm:from:to:nSamplesPerPixel: (in category 'sound tracks') ----- - volumeForm: height from: start to: stop nSamplesPerPixel: nPerPixel - "Note: nPerPixel can be Integer or Float for pixel-perfect alignment." - "In an inspector of a samplesSound... - self currentWorld addMorph: (ImageMorph new image: - (self volumeForm: 32 from: 1 to: samples size nSamplesPerPixel: 225)) - " - | volPlot width max | - width := stop-start//nPerPixel. - volPlot := Form extent: width at height. - (start max: 1) to: (stop min: samples size)-nPerPixel by: nPerPixel do: - [:i | | sample min vol | min:= max:= 0. - i asInteger to: (i+nPerPixel-1) asInteger by: 4 do: "by: 4 makes it faster yet looks the same" - [:j | sample := samples at: j. - sample < min ifTrue: [min := sample]. - sample > max ifTrue: [max := sample]]. - vol := (max - min) * height // 65536. - volPlot fillBlack: ((i-start//nPerPixel) @ (height-vol//2) extent: 1@(vol+1))]. - ^ volPlot - - ! Item was removed: - AbstractSound subclass: #ScorePlayer - instanceVariableNames: 'score instruments overallVolume leftVols rightVols muted rate tempo secsPerTick done repeat ticksSinceStart ticksClockIncr trackEventIndex tempoMapIndex activeSounds activeMIDINotes midiPort midiPlayerProcess durationInTicks' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !ScorePlayer commentStamp: '<historical>' prior: 0! - This is a real-time player for MIDI scores (i.e., scores read from MIDI files). Score can be played using either the internal sound synthesis or an external MIDI synthesizer on platforms that support MIDI output. - ! Item was removed: - ----- Method: ScorePlayer class>>fileReaderServicesForFile:suffix: (in category 'file reader services') ----- - fileReaderServicesForFile: fullName suffix: suffix - - ^ (suffix = 'mid') | (suffix = '*') - ifTrue: [self services] - ifFalse: [#()] - ! Item was removed: - ----- Method: ScorePlayer class>>fromFileNamed: (in category 'instance creation') ----- - fromFileNamed: fileName - - ^ self onScore: (MIDIFileReader scoreFromFileNamed: fileName)! Item was removed: - ----- Method: ScorePlayer class>>initialize (in category 'class initialization') ----- - initialize - - Smalltalk addToShutDownList: self. - FileServices registerFileReader: self.! Item was removed: - ----- Method: ScorePlayer class>>onScore: (in category 'instance creation') ----- - onScore: aMIDIScore - - ^ self new onScore: aMIDIScore - ! Item was removed: - ----- Method: ScorePlayer class>>playFileNamed: (in category 'instance creation') ----- - playFileNamed: fileName - - ^ (MIDISound fromFileNamed: fileName) - play; yourself! Item was removed: - ----- Method: ScorePlayer class>>servicePlayMidiFile (in category 'file reader services') ----- - servicePlayMidiFile - "Answer a service for opening player on a midi file" - - ^ SimpleServiceEntry - provider: self - label: 'play MIDI file' - selector: #playFileNamed: - description: 'play the MIDI file directly' - buttonLabel: 'play'! Item was removed: - ----- Method: ScorePlayer class>>services (in category 'file reader services') ----- - services - - ^ Array with: self servicePlayMidiFile! Item was removed: - ----- Method: ScorePlayer class>>shutDown: (in category 'snapshotting') ----- - shutDown: quitting - - quitting ifTrue: [ - ScorePlayer allSubInstancesDo: [:ea | [ea stopMIDIPlaying] on: Error do: [] ] ].! Item was removed: - ----- Method: ScorePlayer class>>unload (in category 'initialize-release') ----- - unload - - FileServices unregisterFileReader: self ! Item was removed: - ----- Method: ScorePlayer>>adjustVolumeTo:overMSecs: (in category 'volume') ----- - adjustVolumeTo: vol overMSecs: mSecs - | normalizedVolume incr block | - normalizedVolume := (vol asFloat min: 1.0) max: 0.0. - incr := (self overallVolume - normalizedVolume) / mSecs * 50.0. - block := normalizedVolume > 0.0 - ifTrue: [ - [[(normalizedVolume - self overallVolume) abs > 0.01] whileTrue: [self overallVolume: self overallVolume - incr. (Delay forMilliseconds: 50) wait]]] - ifFalse: [ - [[self overallVolume > 0.0] whileTrue: [self overallVolume: self overallVolume - incr. (Delay forMilliseconds: 50) wait]. self pause]]. - block fork - ! Item was removed: - ----- Method: ScorePlayer>>closeMIDIPort (in category 'midi output') ----- - closeMIDIPort - "Stop using MIDI for output. Music will be played using the built-in sound synthesis." - - self pause. - midiPort := nil. - ! Item was removed: - ----- Method: ScorePlayer>>copySounds (in category 'copying') ----- - copySounds - "Private!! Support for copying." - - instruments := instruments copy. - leftVols := leftVols copy. - rightVols := rightVols copy. - muted := muted copy. - self reset. - ! Item was removed: - ----- Method: ScorePlayer>>disableReverb: (in category 'operating') ----- - disableReverb: aBoolean - - aBoolean - ifTrue: [SoundPlayer stopReverb] - ifFalse: [SoundPlayer startReverb]. - ! Item was removed: - ----- Method: ScorePlayer>>doControl (in category 'sound generation') ----- - doControl - - super doControl. - 1 to: activeSounds size do: [:i | (activeSounds at: i) first doControl]. - ticksSinceStart := ticksSinceStart + ticksClockIncr. - self processAllAtTick: ticksSinceStart asInteger. - ! Item was removed: - ----- Method: ScorePlayer>>duration (in category 'accessing') ----- - duration - "Answer the duration in seconds of my MIDI score when played at the current rate. Take tempo changes into account." - - | totalSecs currentTempo lastTempoChangeTick | - totalSecs := 0.0. - currentTempo := 120.0. "quarter notes per minute" - lastTempoChangeTick := 0. - score tempoMap ifNotNil: [ - score tempoMap do: [:tempoEvt | - "accumulate time up to this tempo change event" - secsPerTick := 60.0 / (currentTempo * rate * score ticksPerQuarterNote). - totalSecs := totalSecs + (secsPerTick * (tempoEvt time - lastTempoChangeTick)). - - "set the new tempo" - currentTempo := (120.0 * (500000.0 / tempoEvt tempo)) roundTo: 0.01. - lastTempoChangeTick := tempoEvt time]]. - - "add remaining time through end of score" - secsPerTick := 60.0 / (currentTempo * rate * score ticksPerQuarterNote). - totalSecs := totalSecs + (secsPerTick * (score durationInTicks - lastTempoChangeTick)). - ^ totalSecs - ! Item was removed: - ----- Method: ScorePlayer>>durationInTicks (in category 'accessing') ----- - durationInTicks - - durationInTicks == nil ifTrue: [^ 1000]. - ^ durationInTicks! Item was removed: - ----- Method: ScorePlayer>>infoForTrack: (in category 'accessing') ----- - infoForTrack: i - "Return the info string for the given track." - "Note: MIDI files follow varying conventions on their use of comment strings. Often, the first string in the track suggests the role of that track in the score, such as 'flute 1' or 'soprano'." - - ^ score trackInfo at: i - ! Item was removed: - ----- Method: ScorePlayer>>initialize (in category 'initialization') ----- - initialize - - super initialize. - score := MIDIScore new initialize. - instruments := Array new. - overallVolume := 0.5. - leftVols := Array new. - rightVols := Array new. - muted := Array new. - rate := 1.0. - repeat := false. - durationInTicks := 100.! Item was removed: - ----- Method: ScorePlayer>>instrumentForTrack: (in category 'accessing') ----- - instrumentForTrack: trackIndex - - ^ instruments at: trackIndex - ! Item was removed: - ----- Method: ScorePlayer>>instrumentForTrack:put: (in category 'accessing') ----- - instrumentForTrack: trackIndex put: aSoundProto - - trackIndex > instruments size ifTrue: [^ self]. - instruments at: trackIndex put: aSoundProto. - ! Item was removed: - ----- Method: ScorePlayer>>isDone (in category 'sound generation') ----- - isDone - - | track | - activeSounds size > 0 ifTrue: [^ false]. - activeMIDINotes size > 0 ifTrue: [^ false]. - 1 to: score tracks size do: [:i | - track := score tracks at: i. - (trackEventIndex at: i) <= track size ifTrue: [^ false]]. - (trackEventIndex last) <= score ambientTrack size ifTrue: [^ false]. - ^ true - ! Item was removed: - ----- Method: ScorePlayer>>isPlaying (in category 'sound generation') ----- - isPlaying - ^ SoundPlayer isPlaying: self! Item was removed: - ----- Method: ScorePlayer>>isStereo (in category 'accessing') ----- - isStereo - - ^ true - ! Item was removed: - ----- Method: ScorePlayer>>jumpToTick: (in category 'sound generation') ----- - jumpToTick: startTick - - - self reset. - self processTempoMapAtTick: startTick. - self skipNoteEventsThruTick: startTick. - self skipAmbientEventsThruTick: startTick. - ticksSinceStart := startTick. - ! Item was removed: - ----- Method: ScorePlayer>>midiPlayLoop (in category 'midi output') ----- - midiPlayLoop - - | mSecsPerStep tStart mSecs | - mSecsPerStep := 5. - [done] whileFalse: [ - tStart := Time millisecondClockValue. - self processAllAtTick: ticksSinceStart asInteger. - (Delay forMilliseconds: mSecsPerStep) wait. - mSecs := Time millisecondClockValue - tStart. - mSecs < 0 ifTrue: [mSecs := mSecsPerStep]. "clock wrap" - ticksSinceStart := ticksSinceStart + (mSecs asFloat / (1000.0 * secsPerTick))]. - ! Item was removed: - ----- Method: ScorePlayer>>midiPort (in category 'accessing') ----- - midiPort - - ^ midiPort - ! Item was removed: - ----- Method: ScorePlayer>>millisecondsSinceStart (in category 'accessing') ----- - millisecondsSinceStart - "Answer the approximate number of milliseconds of real time since the beginning of the score. Since this calculation uses the current tempo, which can change throughout the piece, it is safer to use ticksSinceStart for synchronization." - - ^ (secsPerTick * ticksSinceStart * 1000) asInteger - ! Item was removed: - ----- Method: ScorePlayer>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play a number of sounds concurrently. The level of each sound can be set independently for the left and right channels." - - | myLeftVol myRightVol someSoundIsDone pair snd trk left right | - myLeftVol := (leftVol * overallVolume) asInteger. - myRightVol := (rightVol * overallVolume) asInteger. - someSoundIsDone := false. - 1 to: activeSounds size do: [:i | - pair := activeSounds at: i. - snd := pair at: 1. - trk := pair at: 2. - left := (myLeftVol * (leftVols at: trk)) // ScaleFactor. - right := (myRightVol * (rightVols at: trk)) // ScaleFactor. - snd samplesRemaining > 0 - ifTrue: [ - snd mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: left rightVol: right] - ifFalse: [someSoundIsDone := true]]. - - someSoundIsDone ifTrue: [ - activeSounds := activeSounds select: [:p | p first samplesRemaining > 0]]. - ! Item was removed: - ----- Method: ScorePlayer>>mutedForTrack: (in category 'accessing') ----- - mutedForTrack: trackIndex - - ^ muted at: trackIndex - ! Item was removed: - ----- Method: ScorePlayer>>mutedForTrack:put: (in category 'accessing') ----- - mutedForTrack: trackIndex put: aBoolean - - trackIndex > muted size ifTrue: [^ self]. - muted at: trackIndex put: aBoolean. - aBoolean ifFalse: [^ self]. - - "silence any currently sounding notes for this track" - activeSounds do: [:pair | - pair last = trackIndex ifTrue: [activeSounds remove: pair ifAbsent: []]]. - midiPort ifNotNil: [ - activeMIDINotes do: [:pair | - pair last = trackIndex ifTrue: [ - pair first endNoteOnMidiPort: midiPort. - activeMIDINotes remove: pair ifAbsent: []]]]. - ! Item was removed: - ----- Method: ScorePlayer>>mutedState (in category 'accessing') ----- - mutedState - - ^ muted - ! Item was removed: - ----- Method: ScorePlayer>>onScore: (in category 'initialization') ----- - onScore: aMIDIScore - - | trackCount totalVol incr curr pan | - score := aMIDIScore. - trackCount := score tracks size. - durationInTicks := score durationInTicks. - instruments := (1 to: trackCount) collect: [:i | FMSound oboe1]. - leftVols := Array new: trackCount. - rightVols := Array new: trackCount. - muted := Array new: trackCount withAll: false. - rate := 1.0. - repeat := false. - tempo := 120.0. - - trackCount = 0 ifTrue: [^ self]. - 1 to: trackCount do: [:i | - leftVols at: i put: ScaleFactor // 4. - rightVols at: i put: ScaleFactor // 4]. - - "distribute inital panning of tracks left-to-right" - totalVol := 1.0. - incr := totalVol / (((trackCount // 2) + 1) * 2). - curr := 0. - 1 to: trackCount do: [:t | - t even - ifTrue: [pan := curr] - ifFalse: [ - curr := curr + incr. - pan := totalVol - curr]. - self panForTrack: t put: pan]. - - ! Item was removed: - ----- Method: ScorePlayer>>openMIDIPort (in category 'midi output') ----- - openMIDIPort - - midiPort := SimpleMIDIPort openDefault.! Item was removed: - ----- Method: ScorePlayer>>openMIDIPort: (in category 'midi output') ----- - openMIDIPort: portNum - "Open the given MIDI port. Music will be played as MIDI commands to the given MIDI port." - - midiPort := SimpleMIDIPort openOnPortNumber: portNum. - ! Item was removed: - ----- Method: ScorePlayer>>overallVolume (in category 'accessing') ----- - overallVolume - - ^ overallVolume - ! Item was removed: - ----- Method: ScorePlayer>>overallVolume: (in category 'accessing') ----- - overallVolume: aNumber - "Set the overally playback volume to a value between 0.0 (off) and 1.0 (full blast)." - - overallVolume := (aNumber asFloat min: 1.0) max: 0.0. - - ! Item was removed: - ----- Method: ScorePlayer>>panForTrack: (in category 'accessing') ----- - panForTrack: i - - | left right fullVol pan | - left := leftVols at: i. - right := rightVols at: i. - left = right ifTrue: [^ 0.5]. "centered" - fullVol := left max: right. - left < fullVol - ifTrue: [pan := left asFloat / (2.0 * fullVol)] - ifFalse: [pan := 1.0 - (right asFloat / (2.0 * fullVol))]. - ^ pan roundTo: 0.001 - - ! Item was removed: - ----- Method: ScorePlayer>>panForTrack:put: (in category 'accessing') ----- - panForTrack: trackIndex put: aNumber - "Set the left-right pan for this track to a value in the range [0.0..1.0], where 0.0 means full-left." - - | fullVol pan left right | - trackIndex > leftVols size ifTrue: [^ self]. - fullVol := (leftVols at: trackIndex) max: (rightVols at: trackIndex). - pan := (aNumber asFloat min: 1.0) max: 0.0. - pan <= 0.5 - ifTrue: [ "attenuate right channel" - left := fullVol. - right := 2.0 * pan * fullVol] - ifFalse: [ "attenuate left channel" - left := 2.0 * (1.0 - pan) * fullVol. - right := fullVol]. - rightVols at: trackIndex put: right asInteger. - leftVols at: trackIndex put: left asInteger. - ! Item was removed: - ----- Method: ScorePlayer>>pause (in category 'operating') ----- - pause - "Pause this sound. It can be resumed from this point, or reset and resumed to start from the beginning." - - score pauseFrom: self. - super pause. - activeSounds := activeSounds species new. - midiPort ifNotNil: [self stopMIDIPlaying]. - ! Item was removed: - ----- Method: ScorePlayer>>positionInScore (in category 'accessing') ----- - positionInScore - - ^ self ticksSinceStart asFloat / (self durationInTicks max: 1)! Item was removed: - ----- Method: ScorePlayer>>positionInScore: (in category 'accessing') ----- - positionInScore: pos - - self isPlaying ifTrue: [^ self "ignore rude intrusion"]. - ticksSinceStart := pos * durationInTicks. - done := false. - - ! Item was removed: - ----- Method: ScorePlayer>>postCopy (in category 'copying') ----- - postCopy - "Copy my component sounds." - - super postCopy. - self copySounds - ! Item was removed: - ----- Method: ScorePlayer>>processAllAtTick: (in category 'sound generation') ----- - processAllAtTick: scoreTick - - self processTempoMapAtTick: scoreTick. - midiPort - ifNil: [self processNoteEventsAtTick: scoreTick] - ifNotNil: [self processMIDIEventsAtTick: scoreTick]. - self processAmbientEventsAtTick: scoreTick. - self isDone ifTrue: [ - repeat - ifTrue: [self reset] - ifFalse: [done := true]]. - ! Item was removed: - ----- Method: ScorePlayer>>processAmbientEventsAtTick: (in category 'sound generation') ----- - processAmbientEventsAtTick: scoreTick - "Process ambient events through the given tick." - - | i evt | - i := trackEventIndex at: trackEventIndex size. - [evt := score ambientEventAfter: i ticks: scoreTick. - evt ~~ nil] whileTrue: [ - i := i + 1. - evt occurAtTime: scoreTick inScorePlayer: self atIndex: i inEventTrack: score ambientTrack secsPerTick: secsPerTick]. - trackEventIndex at: trackEventIndex size put: i. - ! Item was removed: - ----- Method: ScorePlayer>>processMIDIEventsAtTick: (in category 'midi output') ----- - processMIDIEventsAtTick: scoreTick - "Process note events through the given score tick using MIDI." - - | j evt | - 1 to: score tracks size do: [:i | - j := trackEventIndex at: i. - [evt := score eventForTrack: i after: j ticks: scoreTick. - evt ~~ nil] whileTrue: [ - evt isNoteEvent - ifTrue: [ - (muted at: i) ifFalse: [ - evt startNoteOnMidiPort: midiPort. - activeMIDINotes add: (Array with: evt with: i)]] - ifFalse: [evt outputOnMidiPort: midiPort]. - j := j + 1. - trackEventIndex at: i put: j]]. - self turnOffActiveMIDINotesAt: scoreTick. - ! Item was removed: - ----- Method: ScorePlayer>>processNoteEventsAtTick: (in category 'sound generation') ----- - processNoteEventsAtTick: scoreTick - "Process note events through the given score tick using internal Squeak sound synthesis." - - | instr j evt snd | - 1 to: score tracks size do: [:i | - instr := instruments at: i. - j := trackEventIndex at: i. - [evt := score eventForTrack: i after: j ticks: scoreTick. - evt ~~ nil] whileTrue: [ - (evt isNoteEvent and: [(muted at: i) not]) ifTrue: [ - snd := instr - soundForMidiKey: evt midiKey - dur: secsPerTick * evt duration - loudness: evt velocity asFloat / 127.0. - activeSounds add: (Array with: snd with: i)]. - j := j + 1. - trackEventIndex at: i put: j]]. - ! Item was removed: - ----- Method: ScorePlayer>>processTempoMapAtTick: (in category 'sound generation') ----- - processTempoMapAtTick: scoreTick - "Process tempo changes through the given score tick." - - | map tempoChanged | - map := score tempoMap. - map ifNil: [^ self]. - tempoChanged := false. - [(tempoMapIndex <= map size) and: - [(map at: tempoMapIndex) time <= scoreTick]] whileTrue: [ - tempoChanged := true. - tempoMapIndex := tempoMapIndex + 1]. - - tempoChanged ifTrue: [ - tempo := (120.0 * (500000.0 / (map at: tempoMapIndex - 1) tempo)) roundTo: 0.01. - self tempoOrRateChanged]. - - ! Item was removed: - ----- Method: ScorePlayer>>rate (in category 'accessing') ----- - rate - - ^ rate - ! Item was removed: - ----- Method: ScorePlayer>>rate: (in category 'accessing') ----- - rate: aNumber - "Set the playback rate. For example, a rate of 2.0 will playback at twice normal speed." - - rate := aNumber asFloat. - self tempoOrRateChanged. - ! Item was removed: - ----- Method: ScorePlayer>>repeat (in category 'accessing') ----- - repeat - "Return true if this player will repeat when it gets to the end of the score, false otherwise." - - ^ repeat - ! Item was removed: - ----- Method: ScorePlayer>>repeat: (in category 'accessing') ----- - repeat: aBoolean - "Turn repeat mode on or off." - - repeat := aBoolean. - ! Item was removed: - ----- Method: ScorePlayer>>reset (in category 'sound generation') ----- - reset - - super reset. - tempo := 120.0. - self tempoOrRateChanged. - done := false. - ticksSinceStart := 0. - "one index for each sound track, plus one for the ambient track..." - trackEventIndex := Array new: score tracks size+1 withAll: 1. - tempoMapIndex := 1. - activeSounds := OrderedCollection new. - activeMIDINotes := OrderedCollection new. - score resetFrom: self. - overallVolume ifNil: [overallVolume := 0.5]. - ! Item was removed: - ----- Method: ScorePlayer>>resumePlaying (in category 'operating') ----- - resumePlaying - "Resume playing. Start over if done." - - done ifTrue: [self reset]. - self jumpToTick: ticksSinceStart. "Play up to here in case we got scrolled to new position." - score resumeFrom: self. - midiPort - ifNil: [super resumePlaying] "let the sound player drive sound generation" - ifNotNil: [self startMIDIPlaying]. "start a process to drive MIDI output" - ! Item was removed: - ----- Method: ScorePlayer>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - done - ifTrue: [^ 0] - ifFalse: [^ 1000000]. - ! Item was removed: - ----- Method: ScorePlayer>>score (in category 'accessing') ----- - score - - ^ score - ! Item was removed: - ----- Method: ScorePlayer>>secsPerTick (in category 'accessing') ----- - secsPerTick - - ^ secsPerTick! Item was removed: - ----- Method: ScorePlayer>>settingsString (in category 'accessing') ----- - settingsString - - | s | - s := WriteStream on: (String new: 1000). - s nextPutAll: 'player'; cr. - s tab; nextPutAll: 'rate: ', self rate printString, ';'; cr. - s tab; nextPutAll: 'overallVolume: ', self overallVolume printString, ';'; cr. - 1 to: self trackCount do: [:t | - s tab; nextPutAll: 'instrumentForTrack: ', t printString, - ' put: (AbstractSound soundNamed: #default);'; cr. - s tab; nextPutAll: 'mutedForTrack: ', t printString, - ' put: ', (self mutedForTrack: t) printString, ';'; cr. - s tab; nextPutAll: 'volumeForTrack: ', t printString, - ' put: ', (self volumeForTrack: t) printString, ';'; cr. - s tab; nextPutAll: 'panForTrack: ', t printString, - ' put: ', (self panForTrack: t) printString, ';'; cr]. - s tab; nextPutAll: 'repeat: ', self repeat printString, '.'; cr. - ^ s contents - ! Item was removed: - ----- Method: ScorePlayer>>skipAmbientEventsThruTick: (in category 'sound generation') ----- - skipAmbientEventsThruTick: startTick - "Skip ambient events through the given score tick." - - score ambientTrack withIndexDo: - [:evt :i | evt time > startTick ifTrue: - [^ trackEventIndex at: trackEventIndex size put: i]]. - ! Item was removed: - ----- Method: ScorePlayer>>skipNoteEventsThruTick: (in category 'sound generation') ----- - skipNoteEventsThruTick: startTick - "Skip note events through the given score tick using internal Squeak sound synthesis." - - | j evt | - 1 to: score tracks size do: [:i | - j := trackEventIndex at: i. - [evt := score eventForTrack: i after: j ticks: startTick. - evt == nil] whileFalse: [ - evt isNoteEvent - ifTrue: [ - (((evt time + evt duration) > startTick) and: [(muted at: i) not]) ifTrue: [ - self startNote: evt forStartTick: startTick trackIndex: i]] - ifFalse: [ - midiPort == nil ifFalse: [evt outputOnMidiPort: midiPort]]. - j := j + 1]. - trackEventIndex at: i put: j]. - ! Item was removed: - ----- Method: ScorePlayer>>startMIDIPlaying (in category 'midi output') ----- - startMIDIPlaying - "Start up a process to play this score via MIDI." - - midiPort ensureOpen. - midiPlayerProcess ifNotNil: [midiPlayerProcess terminate]. - midiPlayerProcess := [self midiPlayLoop] newProcess. - midiPlayerProcess - name: 'Score Player (', self score printString, ')'; - priority: Processor userInterruptPriority; - resume. - ! Item was removed: - ----- Method: ScorePlayer>>startNote:forStartTick:trackIndex: (in category 'sound generation') ----- - startNote: noteEvent forStartTick: startTick trackIndex: trackIndex - "Prepare a note to begin playing at the given tick. Used to start playing at an arbitrary point in the score. Handle both MIDI and built-in synthesis cases." - - | snd | - midiPort - ifNil: [ - snd := (instruments at: trackIndex) - soundForMidiKey: noteEvent midiKey - dur: secsPerTick * (noteEvent endTime - startTick) - loudness: noteEvent velocity asFloat / 127.0. - activeSounds add: (Array with: snd with: trackIndex)] - ifNotNil: [ - noteEvent startNoteOnMidiPort: midiPort. - activeMIDINotes add: (Array with: noteEvent with: trackIndex)]. - ! Item was removed: - ----- Method: ScorePlayer>>stopMIDIPlaying (in category 'midi output') ----- - stopMIDIPlaying - "Terminate the MIDI player process and turn off any active notes." - - midiPlayerProcess ifNotNil: [midiPlayerProcess terminate]. - midiPlayerProcess := nil. - activeMIDINotes do: [:pair | pair first endNoteOnMidiPort: midiPort]. - activeMIDINotes := activeMIDINotes species new. - ! Item was removed: - ----- Method: ScorePlayer>>tempo (in category 'accessing') ----- - tempo - "Return the current tempo in beats (quarter notes) per minute. The tempo at any given moment is defined by the score and cannot be changed by the client. To change the playback speed, the client may change the rate parameter." - - ^ tempo - ! Item was removed: - ----- Method: ScorePlayer>>tempoOrRateChanged (in category 'operating') ----- - tempoOrRateChanged - "This method should be called after changing the tempo or rate." - - secsPerTick := 60.0 / (tempo * rate * score ticksPerQuarterNote). - ticksClockIncr := (1.0 / self controlRate) / secsPerTick. - ! Item was removed: - ----- Method: ScorePlayer>>ticksForMSecs: (in category 'accessing') ----- - ticksForMSecs: mSecs - - ^ (mSecs asFloat / (1000.0 * secsPerTick)) rounded - ! Item was removed: - ----- Method: ScorePlayer>>ticksSinceStart (in category 'accessing') ----- - ticksSinceStart - "Answer the number of score ticks that have elapsed since this piece started playing. The duration of a tick is determined by the MIDI score." - - ^ ticksSinceStart - ! Item was removed: - ----- Method: ScorePlayer>>ticksSinceStart: (in category 'accessing') ----- - ticksSinceStart: newTicks - "Adjust ticks to folow, eg, piano roll autoscrolling" - - self isPlaying ifFalse: [ticksSinceStart := newTicks] - ! Item was removed: - ----- Method: ScorePlayer>>trackCount (in category 'accessing') ----- - trackCount - - ^ score tracks size - ! Item was removed: - ----- Method: ScorePlayer>>turnOffActiveMIDINotesAt: (in category 'midi output') ----- - turnOffActiveMIDINotesAt: scoreTick - "Turn off any active MIDI notes that should be turned off at the given score tick." - - | someNoteEnded | - midiPort ifNil: [^ self]. - someNoteEnded := false. - activeMIDINotes do: [:pair | | evt | - evt := pair first. - evt endTime <= scoreTick ifTrue: [ - evt endNoteOnMidiPort: midiPort. - someNoteEnded := true]]. - - someNoteEnded ifTrue: [ - activeMIDINotes := activeMIDINotes select: [:p | p first endTime > scoreTick]]. - ! Item was removed: - ----- Method: ScorePlayer>>updateDuration (in category 'initialization') ----- - updateDuration - - durationInTicks := score durationInTicks. - ! Item was removed: - ----- Method: ScorePlayer>>volumeForTrack: (in category 'accessing') ----- - volumeForTrack: i - - | vol | - vol := (leftVols at: i) max: (rightVols at: i). - ^ (vol asFloat / ScaleFactor) roundTo: 0.0001 - ! Item was removed: - ----- Method: ScorePlayer>>volumeForTrack:put: (in category 'accessing') ----- - volumeForTrack: trackIndex put: aNumber - - | newVol oldLeft oldRight oldFullVol left right | - trackIndex > leftVols size ifTrue: [^ self]. - newVol := ((aNumber asFloat max: 0.0) min: 1.0) * ScaleFactor. - oldLeft := leftVols at: trackIndex. - oldRight := rightVols at: trackIndex. - oldFullVol := oldLeft max: oldRight. - oldFullVol = 0 ifTrue: [oldFullVol := 1.0]. - oldLeft < oldFullVol - ifTrue: [ - left := newVol * oldLeft / oldFullVol. - right := newVol] - ifFalse: [ - left := newVol. - right := newVol * oldRight / oldFullVol]. - leftVols at: trackIndex put: left asInteger. - rightVols at: trackIndex put: right asInteger. - ! Item was removed: - AbstractSound subclass: #SequentialSound - instanceVariableNames: 'sounds currentIndex' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: SequentialSound>>, (in category 'composition') ----- - , aSound - "Return the concatenation of the receiver and the argument sound." - - ^ self add: aSound - ! Item was removed: - ----- Method: SequentialSound>>add: (in category 'composition') ----- - add: aSound - - sounds := sounds copyWith: aSound. - ^aSound - ! Item was removed: - ----- Method: SequentialSound>>compressWith: (in category 'composition') ----- - compressWith: codecClass - ^ self copy transformSounds: [:s | s compressWith: codecClass]! Item was removed: - ----- Method: SequentialSound>>compressWith:atRate: (in category 'composition') ----- - compressWith: codecClass atRate: aSamplingRate - ^ self copy transformSounds: [:s | s compressWith: codecClass atRate: aSamplingRate]! Item was removed: - ----- Method: SequentialSound>>copySounds (in category 'copying') ----- - copySounds - "Private!! Support for copying. Copy my component sounds." - - sounds := sounds collect: [:s | s copy]. - ! Item was removed: - ----- Method: SequentialSound>>doControl (in category 'sound generation') ----- - doControl - - super doControl. - currentIndex > 0 - ifTrue: [(sounds at: currentIndex) doControl]. - ! Item was removed: - ----- Method: SequentialSound>>duration (in category 'accessing') ----- - duration - "Answer the duration of this sound in seconds." - - "7 dec 2000 - handle compressed sounds. better way??" - - ^sounds inject: 0 into: [:totalDuration :snd | totalDuration + snd asSound duration]! Item was removed: - ----- Method: SequentialSound>>initialize (in category 'initialization') ----- - initialize - - super initialize. - sounds := Array new. - currentIndex := 0. - ! Item was removed: - ----- Method: SequentialSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'sound generation') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Play a collection of sounds in sequence." - "PluckedSound chromaticScale play" - - | finalIndex i snd remaining count leftScaledVol rightScaledVol | - currentIndex = 0 ifTrue: [^ self]. "already done" - - leftScaledVol := leftVol * scaledVol / ScaleFactor asFloat. - rightScaledVol := rightVol * scaledVol / ScaleFactor asFloat. - - finalIndex := (startIndex + n) - 1. - i := startIndex. - [i <= finalIndex] whileTrue: [ - snd := (sounds at: currentIndex). - [(remaining := snd samplesRemaining) <= 0] whileTrue: [ - "find next undone sound" - currentIndex < sounds size - ifTrue: [ - currentIndex := currentIndex + 1. - snd := (sounds at: currentIndex)] - ifFalse: [ - currentIndex := 0. - ^ self]]. "no more sounds" - count := (finalIndex - i) + 1. - remaining < count ifTrue: [count := remaining]. - snd mixSampleCount: count into: aSoundBuffer startingAt: i - leftVol: leftScaledVol - rightVol: rightScaledVol. - i := i + count]. - ! Item was removed: - ----- Method: SequentialSound>>postCopy (in category 'copying') ----- - postCopy - "Copy my component sounds." - - super postCopy. - self copySounds - ! Item was removed: - ----- Method: SequentialSound>>pruneFinishedSounds (in category 'composition') ----- - pruneFinishedSounds - "Remove any sounds that have been completely played." - - | newSnds | - (currentIndex > 1 and: [currentIndex < sounds size]) ifFalse: [^ self]. - newSnds := sounds copyFrom: currentIndex to: sounds size. - currentIndex := 1. - sounds := newSnds. - ! Item was removed: - ----- Method: SequentialSound>>removeFirstCompleteSoundOrNil (in category 'composition') ----- - removeFirstCompleteSoundOrNil - "Remove the first sound if it has been completely recorded." - - | firstSound | - - sounds size > 0 ifFalse: [^ nil]. - firstSound := sounds first. - sounds := sounds copyFrom: 2 to: sounds size. - ^firstSound - ! Item was removed: - ----- Method: SequentialSound>>reset (in category 'sound generation') ----- - reset - - super reset. - sounds do: [:snd | snd reset]. - sounds size > 0 ifTrue: [currentIndex := 1]. - ! Item was removed: - ----- Method: SequentialSound>>samplesRemaining (in category 'sound generation') ----- - samplesRemaining - - currentIndex = 0 - ifTrue: [^ 0] - ifFalse: [^ 1000000]. - ! Item was removed: - ----- Method: SequentialSound>>sounds (in category 'accessing') ----- - sounds - - ^ sounds - ! Item was removed: - ----- Method: SequentialSound>>transformSounds: (in category 'copying') ----- - transformSounds: tfmBlock - "Private!! Support for copying. Copy my component sounds." - - sounds := sounds collect: tfmBlock - ! Item was removed: - Object subclass: #SimpleMIDIPort - instanceVariableNames: 'portNumber accessSema lastCommandByteOut' - classVariableNames: 'DefaultPortNumber InterfaceClockRate UseMIDIDeviceForOutput' - poolDictionaries: '' - category: 'Sound-Scores'! - - !SimpleMIDIPort commentStamp: '<historical>' prior: 0! - This is a first cut at a simple MIDI output port. - ! Item was removed: - ----- Method: SimpleMIDIPort class>>anyPortNumFromUser (in category 'utilities') ----- - anyPortNumFromUser - - ^ UIManager default - chooseFrom: ((0 to: self primPortCount - 1) collect:[:i| self portDescription: i]) - values: (0 to: self primPortCount - 1) - title: 'MIDI port for default usage:' translated - ! Item was removed: - ----- Method: SimpleMIDIPort class>>askForDefault (in category 'utilities') ----- - askForDefault - "self askForDefault" - - self anyPortNumFromUser ifNotNil: [:num | - DefaultPortNumber := num].! Item was removed: - ----- Method: SimpleMIDIPort class>>closeAllPorts (in category 'utilities') ----- - closeAllPorts - "Close all MIDI ports." - "SimpleMIDIPort closeAllPorts" - - | lastPortNum | - lastPortNum := self primPortCount - 1. - 0 to: lastPortNum do: [:portNum | self basicNew primMIDIClosePort: portNum]. - ! Item was removed: - ----- Method: SimpleMIDIPort class>>examplePlayNoteNamedVelocityOnChannel (in category 'examples') ----- - examplePlayNoteNamedVelocityOnChannel - "self examplePlayNoteNamedVelocityOnChannel" - - |aPort| - aPort:= self openOnPortNumber: 0. - #('Bottle Blow' 'Shakuhachi' 'Whistle' 'Ocarina' 'Lead 1 (square)' 'Lead 2 (sawtooth)' 'Lead 3 (caliope lead)' 'Lead 4 (chiff lead)' 'Lead 5 (charang)' 'Lead 6 (voice)' 'Lead 7 (fifths)' 'Lead 8 (brass + lead)' 'Pad 1 (new age)' 'Pad 2 (warm)' 'Pad 3 (polysynth)' 'Pad 4 (choir)' 'Pad 5 (bowed)' 'Pad 6 (metallic)' 'Pad 7 (halo)' 'Pad 8 (sweep)' 'FX 1 (rain)' 'FX 2 (soundtrack)' 'FX 3 (crystal)' 'FX 4 (atmosphere)' 'FX 5 (brightness)' 'FX 6 (goblins)' 'FX 7 (echoes)' 'FX 8 (sci-fi)' 'Sitar' 'Banjo' 'Shamisen' 'Koto' 'Kalimba' 'Bagpipe' 'Fiddle' 'Shanai' 'Tinkle Bell' 'Agogo' 'Steel Drums' 'Woodblock' 'Taiko Drum' 'Melodic Tom' 'Synth Drum' 'Reverse Cymbal' 'Guitar Fret Noise' 'Breath Noise' 'Seashore' 'Bird Tweet' 'Telephone Ring' 'Helicopter' 'Applause' 'Gunshot' ) do: [:anInstrumentName | - [aPort useInstrument: anInstrumentName onChannel: 0. - aPort playNoteNamed: 'c4' onChannel: 0. - (Delay forMilliseconds: 250) wait. - aPort stopNoteNamed: 'c4' onChannel: 0] ensure: [aPort close]]! Item was removed: - ----- Method: SimpleMIDIPort class>>initialize (in category 'class initialization') ----- - initialize - "SimpleMIDIPort initialize" - - InterfaceClockRate := 1000000. - DefaultPortNumber := 0. - ! Item was removed: - ----- Method: SimpleMIDIPort class>>inputPortNumFromUser (in category 'utilities') ----- - inputPortNumFromUser - "Prompt the user for a MIDI input port. Answer a port number, or nil if the user does not select a port or if MIDI is not supported on this platform." - "SimpleMIDIPort inputPortNumFromUser" - - | portCount dir portList | - portCount := self primPortCount. - portCount = 0 ifTrue: [^ nil]. - portList := OrderedCollection new. - 0 to: portCount - 1 do:[:i | - dir := self primPortDirectionalityOf: i. - (dir = 1) | (dir = 3) ifTrue:[portList add: i]]. - ^UIManager default - chooseFrom: (portList collect:[:i| self portDescription: i]) - values: portList - title: 'MIDI port for input:' translated - ! Item was removed: - ----- Method: SimpleMIDIPort class>>midiInstruments (in category 'utilities') ----- - midiInstruments - "self midiInstruments" - ^ #('Acoustic Grand Piano' 'Bright Acoustic Piano' 'Electric Grand Piano' 'Honky-tonk Piano' 'Rhodes Piano' 'Chorused Piano' 'Harpsichord' 'Clavinet' 'Celesta' 'Glockenspiel' 'Music box' 'Vibraphone' 'Marimba' 'Xylophone' 'Tubular Bells' 'Dulcimer' 'Hammond Organ' 'Percussive Organ' 'Rock Organ' 'Church Organ' 'Reed Organ' 'Accordian' 'Harmonica' 'Tango Accordian' 'Acoustic Guitar (nylon)' 'Acoustic Guitar (steel)' 'Electric Guitar (jazz)' 'Electric Guitar (clean)' 'Electric Guitar (muted)' 'Overdriven Guitar' 'Distortion Guitar' 'Guitar Harmonics' 'Acoustic Bass' 'Electric Bass (finger)' 'Electric Bass (pick)' 'Fretless Bass' 'Slap Bass 1' 'Slap Bass 2' 'Synth Bass 1' 'Synth Bass 2' 'Violin' 'Viola' 'Cello' 'Contrabass' 'Tremolo Strings' 'Pizzicato Strings' 'Orchestral Harp' 'Timpani' 'String Ensemble 1' 'String Ensemble 2' 'Synth Strings 1' 'Synth Strings 2' 'Choir Aahs' 'Voice Oohs' 'Synth Voice' 'Orchestra Hit' 'Trumpet' 'Trombone' 'Tuba' 'Muted Trumpet' 'French Horn' 'Brass S ection' 'Synth Brass 1' 'Synth Brass 2' 'Soprano Sax' 'Alto Sax' 'Tenor Sax' 'Baritone Sax' 'Oboe' 'English Horn' 'Bassoon' 'Clarinet' 'Piccolo' 'Flute' 'Recorder' 'Pan Flute' 'Bottle Blow' 'Shakuhachi' 'Whistle' 'Ocarina' 'Lead 1 (square)' 'Lead 2 (sawtooth)' 'Lead 3 (caliope lead)' 'Lead 4 (chiff lead)' 'Lead 5 (charang)' 'Lead 6 (voice)' 'Lead 7 (fifths)' 'Lead 8 (brass + lead)' 'Pad 1 (new age)' 'Pad 2 (warm)' 'Pad 3 (polysynth)' 'Pad 4 (choir)' 'Pad 5 (bowed)' 'Pad 6 (metallic)' 'Pad 7 (halo)' 'Pad 8 (sweep)' 'FX 1 (rain)' 'FX 2 (soundtrack)' 'FX 3 (crystal)' 'FX 4 (atmosphere)' 'FX 5 (brightness)' 'FX 6 (goblins)' 'FX 7 (echoes)' 'FX 8 (sci-fi)' 'Sitar' 'Banjo' 'Shamisen' 'Koto' 'Kalimba' 'Bagpipe' 'Fiddle' 'Shanai' 'Tinkle Bell' 'Agogo' 'Steel Drums' 'Woodblock' 'Taiko Drum' 'Melodic Tom' 'Synth Drum' 'Reverse Cymbal' 'Guitar Fret Noise' 'Breath Noise' 'Seashore' 'Bird Tweet' 'Telephone Ring' 'Helicopter' 'Applause' 'Gunshot' )! Item was removed: - ----- Method: SimpleMIDIPort class>>midiIsSupported (in category 'utilities') ----- - midiIsSupported - "Answer true if this platform supports MIDI." - - ^ self primPortCount > 0 - ! Item was removed: - ----- Method: SimpleMIDIPort class>>openDefault (in category 'instance creation') ----- - openDefault - "Answer a new instance of me opened on the default MIDI port." - - ^ self openOnPortNumber: DefaultPortNumber - ! Item was removed: - ----- Method: SimpleMIDIPort class>>openOnPortNumber: (in category 'instance creation') ----- - openOnPortNumber: portNum - "Answer a new instance of me for the given MIDI port number." - "Details: All clients of a particular MIDI port should share the same instance of me. This allows accesses to the port to be serialized and shared port-related state state to be maintained." - - SimpleMIDIPort allSubInstancesDo: [:p | - p portNumber = portNum ifTrue: [ - "share the existing port object for this port number" - ^ p]]. - - ^ super new openOnPortNumber: portNum - ! Item was removed: - ----- Method: SimpleMIDIPort class>>outputPortNumFromUser (in category 'utilities') ----- - outputPortNumFromUser - "Prompt the user for a MIDI output port. Answer a port number, or nil if the user does not select a port or if MIDI is not supported on this platform." - "SimpleMIDIPort outputPortNumFromUser" - - | portCount dir portList | - portCount := self primPortCount. - portCount = 0 ifTrue: [^ nil]. - portList := OrderedCollection new. - 0 to: portCount - 1 do:[:i | - dir := self primPortDirectionalityOf: i. - (dir = 2) | (dir = 3) ifTrue:[portList add: i]]. - ^UIManager default - chooseFrom: (portList collect:[:i| self portDescription: i]) - values: portList - title: 'MIDI port for output:' translated. - - ! Item was removed: - ----- Method: SimpleMIDIPort class>>percussionInstruments (in category 'utilities') ----- - percussionInstruments - "self percussionInstruments" - ^ #('Bottle Blow' 'Shakuhachi' 'Whistle' 'Ocarina' 'Lead 1 (square)' 'Lead 2 (sawtooth)' 'Lead 3 (caliope lead)' 'Lead 4 (chiff lead)' 'Lead 5 (charang)' 'Lead 6 (voice)' 'Lead 7 (fifths)' 'Lead 8 (brass + lead)' 'Pad 1 (new age)' 'Pad 2 (warm)' 'Pad 3 (polysynth)' 'Pad 4 (choir)' 'Pad 5 (bowed)' 'Pad 6 (metallic)' 'Pad 7 (halo)' 'Pad 8 (sweep)' 'FX 1 (rain)' 'FX 2 (soundtrack)' 'FX 3 (crystal)' 'FX 4 (atmosphere)' 'FX 5 (brightness)' 'FX 6 (goblins)' 'FX 7 (echoes)' 'FX 8 (sci-fi)' 'Sitar' 'Banjo' 'Shamisen' 'Koto' 'Kalimba' 'Bagpipe' 'Fiddle' 'Shanai' 'Tinkle Bell' 'Agogo' 'Steel Drums' 'Woodblock' 'Taiko Drum' 'Melodic Tom' 'Synth Drum' 'Reverse Cymbal' 'Guitar Fret Noise' 'Breath Noise' 'Seashore' 'Bird Tweet' 'Telephone Ring' 'Helicopter' 'Applause' 'Gunshot' )! Item was removed: - ----- Method: SimpleMIDIPort class>>portDescription: (in category 'utilities') ----- - portDescription: portNum - "Answer a string indicating the directionality of the given MIDI port." - "(0 to: SimpleMIDIPort primPortCount - 1) collect: - [:i | SimpleMIDIPort portDescription: i]" - - | portName dir | - portName := (self primPortNameOf: portNum) convertFromSystemString. - dir := self primPortDirectionalityOf: portNum. - dir = 1 ifTrue: [^ portName, ' (in)']. - dir = 2 ifTrue: [^ portName, ' (out)']. - dir = 3 ifTrue: [^ portName, ' (in/out)']. - ^ self error: 'unknown MIDI port directionality' - ! Item was removed: - ----- Method: SimpleMIDIPort class>>primPortCount (in category 'primitives') ----- - primPortCount - "Answer the number of MIDI ports supported by this platform, or zero if this primitive is not implemented." - - <primitive: 'primitiveMIDIGetPortCount' module: 'MIDIPlugin'> - ^ 0 - ! Item was removed: - ----- Method: SimpleMIDIPort class>>primPortDirectionalityOf: (in category 'primitives') ----- - primPortDirectionalityOf: portNum - "Answer the platform-specific name for the given MIDI port." - - <primitive: 'primitiveMIDIGetPortDirectionality' module: 'MIDIPlugin'> - self primitiveFailed. - ! Item was removed: - ----- Method: SimpleMIDIPort class>>primPortNameOf: (in category 'primitives') ----- - primPortNameOf: portNum - "Answer the platform-specific name for the given MIDI port." - - <primitive: 'primitiveMIDIGetPortName' module: 'MIDIPlugin'> - self primitiveFailed. - ! Item was removed: - ----- Method: SimpleMIDIPort class>>useMIDIDeviceForOutput (in category 'preferences') ----- - useMIDIDeviceForOutput - - <preference: 'Use MIDI device for output' - category: #media - description: 'If true, will try to open a native MIDI device when playing MIDI scores.' - type: #Boolean> - ^ UseMIDIDeviceForOutput ifNil: [false]! Item was removed: - ----- Method: SimpleMIDIPort class>>useMIDIDeviceForOutput: (in category 'preferences') ----- - useMIDIDeviceForOutput: boolean - - UseMIDIDeviceForOutput := boolean.! Item was removed: - ----- Method: SimpleMIDIPort>>bufferTimeStampFrom: (in category 'input') ----- - bufferTimeStampFrom: aByteArray - "Return the timestamp from the given MIDI input buffer. Assume the given buffer is at least 4 bytes long." - - ^ ((aByteArray at: 1) bitShift: 24) + - ((aByteArray at: 2) bitShift: 16) + - ((aByteArray at: 3) bitShift: 8) + - (aByteArray at: 4) - ! Item was removed: - ----- Method: SimpleMIDIPort>>close (in category 'open/close') ----- - close - "Close this MIDI port." - - portNumber ifNotNil: [self primMIDIClosePort: portNumber]. - accessSema := nil. - lastCommandByteOut := nil. - ! Item was removed: - ----- Method: SimpleMIDIPort>>ensureOpen (in category 'open/close') ----- - ensureOpen - "Make sure this MIDI port is open. It is good to call this before starting to use a port in case an intervening image save/restore has caused the underlying hardware port to get closed." - - portNumber ifNil: [^ self error: 'Use "openOn:" to open a MIDI port initially']. - self primMIDIClosePort: portNumber. - self primMIDIOpenPort: portNumber readSemaIndex: 0 interfaceClockRate: InterfaceClockRate. - accessSema := Semaphore forMutualExclusion. - lastCommandByteOut := Array new: 16 withAll: 0. "clear running status" - ! Item was removed: - ----- Method: SimpleMIDIPort>>flushInput (in category 'input') ----- - flushInput - "Read any lingering MIDI data from this port's input buffer." - - | buf | - buf := ByteArray new: 1000. - [(self readInto: buf) > 0] whileTrue. - ! Item was removed: - ----- Method: SimpleMIDIPort>>midiCmd:channel:byte: (in category 'output') ----- - midiCmd: cmd channel: channel byte: dataByte - "Immediately output the given MIDI command with the given channel and argument byte to this MIDI port. Assume that the port is open." - - accessSema critical: [ - self primMIDIWritePort: portNumber - from: (ByteArray - with: (cmd bitOr: channel) - with: dataByte) - at: 0]. - ! Item was removed: - ----- Method: SimpleMIDIPort>>midiCmd:channel:byte:byte: (in category 'output') ----- - midiCmd: cmd channel: channel byte: dataByte1 byte: dataByte2 - "Immediately output the given MIDI command with the given channel and argument bytes to this MIDI port. Assume that the port is open." - - accessSema critical: [ - self primMIDIWritePort: portNumber - from: (ByteArray - with: (cmd bitOr: channel) - with: dataByte1 - with: dataByte2) - at: 0]. - ! Item was removed: - ----- Method: SimpleMIDIPort>>midiOutput: (in category 'output') ----- - midiOutput: aByteArray - "Output the given bytes to this MIDI port immediately. Assume that the port is open." - - accessSema critical: [ - self primMIDIWritePort: portNumber from: aByteArray at: 0]. - ! Item was removed: - ----- Method: SimpleMIDIPort>>openOnPortNumber: (in category 'open/close') ----- - openOnPortNumber: portNum - "Open this MIDI port on the given port number." - - self close. - portNumber := portNum. - accessSema := Semaphore forMutualExclusion. - self ensureOpen. - ! Item was removed: - ----- Method: SimpleMIDIPort>>playNote:onChannel: (in category 'primitives') ----- - playNote: aNote onChannel: aChannel - self playNote: aNote velocity: 64 onChannel: aChannel! Item was removed: - ----- Method: SimpleMIDIPort>>playNote:velocity:onChannel: (in category 'primitives') ----- - playNote: aNote velocity: aVel onChannel: aChannel - self midiCmd: 144 channel: aChannel byte: aNote byte: aVel! Item was removed: - ----- Method: SimpleMIDIPort>>playNoteNamed:onChannel: (in category 'primitives') ----- - playNoteNamed: aNotename onChannel: aChannel - self playNoteNamed: aNotename velocity: 64 onChannel: aChannel! Item was removed: - ----- Method: SimpleMIDIPort>>playNoteNamed:velocity:onChannel: (in category 'primitives') ----- - playNoteNamed: aNotename velocity: aVel onChannel: aChannel - self playNote: (AbstractSound midiKeyForPitch: aNotename) velocity: aVel onChannel: aChannel - - ! Item was removed: - ----- Method: SimpleMIDIPort>>portNumber (in category 'open/close') ----- - portNumber - "Answer my port number." - - ^ portNumber - ! Item was removed: - ----- Method: SimpleMIDIPort>>primMIDIClosePort: (in category 'primitives') ----- - primMIDIClosePort: portNum - "Close the given MIDI port. Don't fail if port is already closed." - - <primitive: 'primitiveMIDIClosePort' module: 'MIDIPlugin'> - ! Item was removed: - ----- Method: SimpleMIDIPort>>primMIDIOpenPort:readSemaIndex:interfaceClockRate: (in category 'primitives') ----- - primMIDIOpenPort: portNum readSemaIndex: readSemaIndex interfaceClockRate: interfaceClockRate - "Open the given MIDI port. If non-zero, readSemaIndex specifies the index in the external objects array of a semaphore to be signalled when incoming MIDI data is available. Not all platforms support signalling the read semaphore. InterfaceClockRate specifies the clock rate of the external MIDI interface adaptor on Macintosh computers; it is ignored on other platforms." - - <primitive: 'primitiveMIDIOpenPort' module: 'MIDIPlugin'> - self primitiveFailed. - ! Item was removed: - ----- Method: SimpleMIDIPort>>primMIDIReadPort:into: (in category 'primitives') ----- - primMIDIReadPort: portNum into: byteArray - "Read any available MIDI data into the given buffer (up to the size of the buffer) and answer the number of bytes read." - - <primitive: 'primitiveMIDIRead' module: 'MIDIPlugin'> - self primitiveFailed. - ! Item was removed: - ----- Method: SimpleMIDIPort>>primMIDIWritePort:from:at: (in category 'primitives') ----- - primMIDIWritePort: portNum from: byteArray at: midiClockValue - "Queue the given data to be sent through the given MIDI port at the given time. If midiClockValue is zero, send the data immediately." - - <primitive: 'primitiveMIDIWrite' module: 'MIDIPlugin'> - self primitiveFailed. - ! Item was removed: - ----- Method: SimpleMIDIPort>>readInto: (in category 'input') ----- - readInto: aByteArray - "Read any data from this port into the given buffer." - - ^ self primMIDIReadPort: portNumber into: aByteArray - ! Item was removed: - ----- Method: SimpleMIDIPort>>stopNote:onChannel: (in category 'primitives') ----- - stopNote: aNote onChannel: aChannel - self stopNote: aNote velocity: 64 onChannel: aChannel! Item was removed: - ----- Method: SimpleMIDIPort>>stopNote:velocity:onChannel: (in category 'primitives') ----- - stopNote: aNote velocity: aVel onChannel: aChannel - self midiCmd: 128 channel: aChannel byte: aNote byte: aVel! Item was removed: - ----- Method: SimpleMIDIPort>>stopNoteNamed:onChannel: (in category 'primitives') ----- - stopNoteNamed: aNotename onChannel: aChannel - self stopNoteNamed: aNotename velocity: 64 onChannel: aChannel! Item was removed: - ----- Method: SimpleMIDIPort>>stopNoteNamed:velocity:onChannel: (in category 'primitives') ----- - stopNoteNamed: aNotename velocity: aVel onChannel: aChannel - self stopNote: (AbstractSound midiKeyForPitch: aNotename) velocity: aVel onChannel: aChannel - ! Item was removed: - ----- Method: SimpleMIDIPort>>useInstrument:onChannel: (in category 'open/close') ----- - useInstrument: aName onChannel: aChannel - self useInstrumentNumber: (self class midiInstruments indexOf: aName)-1 onChannel: aChannel! Item was removed: - ----- Method: SimpleMIDIPort>>useInstrumentNumber:onChannel: (in category 'open/close') ----- - useInstrumentNumber: aNumber onChannel: aChannel - self ensureOpen. - self midiCmd: 192 channel: aChannel byte: aNumber ! Item was removed: - ArrayedCollection variableWordSubclass: #SoundBuffer - instanceVariableNames: '' - classVariableNames: 'SineTable' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !SoundBuffer commentStamp: '<historical>' prior: 0! - SoundBuffers store 16 bit unsigned quantities. ! Item was removed: - ----- Method: SoundBuffer class>>averageEvery:from:upTo: (in category 'instance creation') ----- - averageEvery: nSamples from: anotherBuffer upTo: inCount - - ^(self newMonoSampleCount: inCount // nSamples) - averageEvery: nSamples - from: anotherBuffer - upTo: inCount! Item was removed: - ----- Method: SoundBuffer class>>fromArray: (in category 'instance creation') ----- - fromArray: anArray - "Return a new SoundBuffer whose contents are copied from the given Array or ByteArray." - - | new | - new := SoundBuffer newMonoSampleCount: anArray size. - 1 to: anArray size do: [:i | new at: i put: (anArray at: i)]. - ^ new - ! Item was removed: - ----- Method: SoundBuffer class>>fromByteArray: (in category 'instance creation') ----- - fromByteArray: aByteArray - "Convert the given ByteArray (stored with the most significant byte first) into 16-bit sample buffer." - - | n buf src w | - n := aByteArray size // 2. - buf := SoundBuffer newMonoSampleCount: n. - src := 1. - 1 to: n do: [:i | - w := ((aByteArray at: src) bitShift: 8) + (aByteArray at: src + 1). - w > 32767 ifTrue: [w := w - 65536]. - buf at: i put: w. - src := src + 2]. - ^ buf - ! Item was removed: - ----- Method: SoundBuffer class>>initialize (in category 'class initialization') ----- - initialize - "Build a sine wave table." - "SoundBuffer initialize" - - | tableSize radiansPerStep peak | - tableSize := 4000. - SineTable := self newMonoSampleCount: tableSize. - radiansPerStep := (2.0 * Float pi) / tableSize asFloat. - peak := ((1 bitShift: 15) - 1) asFloat. "range is +/- (2^15 - 1)" - 1 to: tableSize do: [:i | - SineTable at: i put: (peak * (radiansPerStep * (i - 1)) sin) rounded]. - ! Item was removed: - ----- Method: SoundBuffer class>>new: (in category 'instance creation') ----- - new: anInteger - "See the comment in newMonoSampleCount:. To avoid confusion, it is best to create new instances using newMonoSampleCount: or newStereoSampleCount:." - - ^ self newMonoSampleCount: anInteger - ! Item was removed: - ----- Method: SoundBuffer class>>newMonoSampleCount: (in category 'instance creation') ----- - newMonoSampleCount: anInteger - "Return a SoundBuffer large enough to hold the given number of monaural samples (i.e., 16-bit words)." - "Details: The size is rounded up to an even number, since the underlying representation is in terms of 32-bit words." - - ^ self basicNew: (anInteger + 1) // 2 - ! Item was removed: - ----- Method: SoundBuffer class>>newStereoSampleCount: (in category 'instance creation') ----- - newStereoSampleCount: anInteger - "Return a SoundBuffer large enough to hold the given number of stereo slices. A stereo 'slice' consists of two 16-bit samples, one for each channel." - - ^ self basicNew: anInteger - ! Item was removed: - ----- Method: SoundBuffer class>>sineTable (in category 'class initialization') ----- - sineTable - "Answer a SoundBuffer containing one complete cycle of a sine wave." - - ^ SineTable - ! Item was removed: - ----- Method: SoundBuffer class>>startUp (in category 'objects from disk') ----- - startUp - "Check if the word order has changed from the last save." - - | la | - la := ShortIntegerArray classPool at: #LastSaveOrder. - ((la at: 2) = 42 and: [(la at: 1) = 13]) - ifTrue: [^self swapHalves]. "Reverse the two 16-bit halves." - "Another reversal happened automatically which reversed the bytes." - ! Item was removed: - ----- Method: SoundBuffer class>>startUpFrom: (in category 'objects from disk') ----- - startUpFrom: endiannessHasToBeFixed - "In this case, do we need to swap word halves when reading this segment?" - - ^endiannessHasToBeFixed - ifTrue: [Message selector: #swapHalves "will be run on each instance"] - ifFalse: [nil]! Item was removed: - ----- Method: SoundBuffer>>asByteArray (in category 'utilities') ----- - asByteArray - "Answer a ByteArray containing my sample data serialized in most-significant byte first order." - - | sampleCount bytes dst s | - sampleCount := self monoSampleCount. - bytes := ByteArray new: 2 * sampleCount. - dst := 0. - 1 to: sampleCount do: [:src | - s := self at: src. - bytes at: (dst := dst + 1) put: ((s bitShift: -8) bitAnd: 255). - bytes at: (dst := dst + 1) put: (s bitAnd: 255)]. - ^ bytes - - ! Item was removed: - ----- Method: SoundBuffer>>at: (in category 'primitives') ----- - at: index - "Return the 16-bit integer value at the given index of the receiver." - - <primitive: 143> - index isInteger ifTrue: [self errorSubscriptBounds: index]. - index isNumber ifTrue: [^ self at: index truncated]. - self errorNonIntegerIndex. - ! Item was removed: - ----- Method: SoundBuffer>>at:put: (in category 'primitives') ----- - at: index put: value - "Store the given 16-bit integer at the given index in the receiver." - - <primitive: 144> - index isInteger - ifTrue: [ - (index >= 1 and: [index <= self size]) - ifTrue: [self errorImproperStore] - ifFalse: [self errorSubscriptBounds: index]]. - index isNumber ifTrue: [^ self at: index truncated put: value]. - self errorNonIntegerIndex. - ! Item was removed: - ----- Method: SoundBuffer>>averageEvery:from:upTo: (in category 'utilities') ----- - averageEvery: nSamples from: anotherBuffer upTo: inCount - - | fromIndex sum | - - fromIndex := 1. - 1 to: inCount // nSamples do: [ :i | - sum := 0. - nSamples timesRepeat: [ - sum := sum + (anotherBuffer at: fromIndex). - fromIndex := fromIndex + 1. - ]. - self at: i put: sum // nSamples. - ]. - ! Item was removed: - ----- Method: SoundBuffer>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 2! Item was removed: - ----- Method: SoundBuffer>>downSampledLowPassFiltering: (in category 'utilities') ----- - downSampledLowPassFiltering: doFiltering - "Answer a new SoundBuffer half the size of the receiver consisting of every other sample. If doFiltering is true, a simple low-pass filter is applied to avoid aliasing of high frequencies. Assume that receiver is monophonic." - "Details: The simple low-pass filter in the current implementation could be improved, at some additional cost." - - | n resultBuf j | - n := self monoSampleCount. - resultBuf := SoundBuffer newMonoSampleCount: n // 2. - j := 0. - doFiltering - ifTrue: [ - 1 to: n by: 2 do: [:i | - resultBuf at: (j := j + 1) put: - (((self at: i) + (self at: i + 1)) bitShift: -1)]] - ifFalse: [ - 1 to: n by: 2 do: [:i | - resultBuf at: (j := j + 1) put: (self at: i)]]. - - ^ resultBuf! Item was removed: - ----- Method: SoundBuffer>>extractLeftChannel (in category 'utilities') ----- - extractLeftChannel - "Answer a new SoundBuffer half the size of the receiver consisting of only the left channel of the receiver, which is assumed to contain stereo sound data." - - | n resultBuf j | - n := self monoSampleCount. - resultBuf := SoundBuffer newMonoSampleCount: n // 2. - j := 0. - 1 to: n by: 2 do: [:i | resultBuf at: (j := j + 1) put: (self at: i)]. - ^ resultBuf! Item was removed: - ----- Method: SoundBuffer>>extractRightChannel (in category 'utilities') ----- - extractRightChannel - "Answer a new SoundBuffer half the size of the receiver consisting of only the right channel of the receiver, which is assumed to contain stereo sound data." - - | n resultBuf j | - n := self monoSampleCount. - resultBuf := SoundBuffer newMonoSampleCount: n // 2. - j := 0. - 2 to: n by: 2 do: [:i | resultBuf at: (j := j + 1) put: (self at: i)]. - ^ resultBuf! Item was removed: - ----- Method: SoundBuffer>>indexOfFirstSampleOver: (in category 'utilities') ----- - indexOfFirstSampleOver: threshold - "Return the index of the first sample whose absolute value is over the given threshold value. Return an index one greater than my size if no sample is over the threshold." - - 1 to: self size do: [:i | - (self at: i) abs > threshold ifTrue: [^ i]]. - ^ self size + 1! Item was removed: - ----- Method: SoundBuffer>>indexOfLastSampleOver: (in category 'utilities') ----- - indexOfLastSampleOver: threshold - "Return the index of the last sample whose absolute value is over the given threshold value. Return zero if no sample is over the threshold." - - self size to: 1 by: -1 do: [:i | - (self at: i) abs > threshold ifTrue: [^ i]]. - ^ 0 - ! Item was removed: - ----- Method: SoundBuffer>>lowPassFiltered (in category 'utilities') ----- - lowPassFiltered - "Answer a simple low-pass filtered copy of this buffer. Assume it is monophonic." - - | sz out last this | - sz := self monoSampleCount. - out := self shallowCopy. - last := self at: 1. - 2 to: sz do: [:i | - this := self at: i. - out at: i put: (this + last) // 2. - last := this]. - ^ out - ! Item was removed: - ----- Method: SoundBuffer>>mergeStereo (in category 'utilities') ----- - mergeStereo - "Answer a new SoundBuffer half the size of the receiver that mixes the left and right stereo channels of the receiver, which is assumed to contain stereo sound data." - - | n resultBuf j | - n := self monoSampleCount. - resultBuf := SoundBuffer newMonoSampleCount: n // 2. - j := 0. - 1 to: n by: 2 do: [:i | resultBuf at: (j := j + 1) put: (((self at: i) + (self at: i + 1)) // 2)]. - ^ resultBuf - ! Item was removed: - ----- Method: SoundBuffer>>monoSampleCount (in category 'accessing') ----- - monoSampleCount - "Return the number of monaural 16-bit samples that fit into this SoundBuffer." - - ^ super size * 2 - ! Item was removed: - ----- Method: SoundBuffer>>normalized: (in category 'utilities') ----- - normalized: percentOfFullVolume - "Increase my amplitudes so that the highest peak is the given percent of full volume. For example 's normalized: 50' would normalize to half of full volume." - - | peak s mult | - peak := 0. - 1 to: self size do: [:i | - s := (self at: i) abs. - s > peak ifTrue: [peak := s]]. - mult := (32767.0 * percentOfFullVolume) / (100.0 * peak). - 1 to: self size do: [:i | self at: i put: (mult * (self at: i)) asInteger]. - ! Item was removed: - ----- Method: SoundBuffer>>primFill: (in category 'primitives') ----- - primFill: aPositiveInteger - "Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays." - "Note: Since 16-bit word arrays are not built into the virtual machine, this primitive fills by 32-bit words." - - <primitive: 145> - self errorImproperStore. - ! Item was removed: - ----- Method: SoundBuffer>>restoreEndianness (in category 'objects from disk') ----- - restoreEndianness - "This word object was just read in from a stream. It was stored in Big Endian (Mac) format. Swap each pair of bytes (16-bit word), if the current machine is Little Endian. - Why is this the right thing to do? We are using memory as a byteStream. High and low bytes are reversed in each 16-bit word, but the stream of words ascends through memory. Different from a Bitmap." - - | hack blt | - Smalltalk isLittleEndian ifTrue: [ - "The implementation is a hack, but fast for large ranges" - hack := Form new hackBits: self. - blt := (BitBlt toForm: hack) sourceForm: hack. - blt combinationRule: Form reverse. "XOR" - blt sourceY: 0; destY: 0; height: self size; width: 1. - blt sourceX: 0; destX: 1; copyBits. "Exchange bytes 0 and 1" - blt sourceX: 1; destX: 0; copyBits. - blt sourceX: 0; destX: 1; copyBits. - blt sourceX: 2; destX: 3; copyBits. "Exchange bytes 2 and 3" - blt sourceX: 3; destX: 2; copyBits. - blt sourceX: 2; destX: 3; copyBits]. - - ! Item was removed: - ----- Method: SoundBuffer>>reverseEndianness (in category 'objects from disk') ----- - reverseEndianness - "Swap the bytes of each 16-bit word, using a fast BitBlt hack." - - | hack blt | - hack := Form new hackBits: self. - blt := (BitBlt toForm: hack) sourceForm: hack. - blt combinationRule: Form reverse. "XOR" - blt sourceY: 0; destY: 0; height: self size; width: 1. - blt sourceX: 0; destX: 1; copyBits. "Exchange bytes 0 and 1" - blt sourceX: 1; destX: 0; copyBits. - blt sourceX: 0; destX: 1; copyBits. - blt sourceX: 2; destX: 3; copyBits. "Exchange bytes 2 and 3" - blt sourceX: 3; destX: 2; copyBits. - blt sourceX: 2; destX: 3; copyBits. - ! Item was removed: - ----- Method: SoundBuffer>>saveAsAIFFFileSamplingRate:on: (in category 'utilities') ----- - saveAsAIFFFileSamplingRate: rate on: aBinaryStream - "Store this mono sound buffer in AIFF file format with the given sampling rate on the given stream." - - | sampleCount s swapBytes | - sampleCount := self monoSampleCount. - aBinaryStream nextPutAll: 'FORM' asByteArray. - aBinaryStream nextInt32Put: (2 * sampleCount) + ((7 * 4) + 18). - aBinaryStream nextPutAll: 'AIFF' asByteArray. - aBinaryStream nextPutAll: 'COMM' asByteArray. - aBinaryStream nextInt32Put: 18. - aBinaryStream nextNumber: 2 put: 1. "channels" - aBinaryStream nextInt32Put: sampleCount. - aBinaryStream nextNumber: 2 put: 16. "bits/sample" - self storeExtendedFloat: rate on: aBinaryStream. - aBinaryStream nextPutAll: 'SSND' asByteArray. - aBinaryStream nextInt32Put: (2 * sampleCount) + 8. - aBinaryStream nextInt32Put: 0. - aBinaryStream nextInt32Put: 0. - - (aBinaryStream isKindOf: StandardFileStream) ifTrue: [ - "optimization: write sound buffer directly to file" - swapBytes := Smalltalk isLittleEndian. - swapBytes ifTrue: [self reverseEndianness]. "make big endian" - aBinaryStream next: (self size // 2) putAll: self startingAt: 1. "size in words" - swapBytes ifTrue: [self reverseEndianness]. "revert to little endian" - ^ self]. - - 1 to: sampleCount do: [:i | - s := self at: i. - aBinaryStream nextPut: ((s bitShift: -8) bitAnd: 16rFF). - aBinaryStream nextPut: (s bitAnd: 16rFF)]. - ! Item was removed: - ----- Method: SoundBuffer>>size (in category 'accessing') ----- - size - "Return the number of 16-bit sound samples that fit in this sound buffer. To avoid confusion, it is better to get the size of SoundBuffer using monoSampleCount or stereoSampleCount." - - ^ self monoSampleCount - ! Item was removed: - ----- Method: SoundBuffer>>splitStereo (in category 'utilities') ----- - splitStereo - "Answer an array of two SoundBuffers half the size of the receiver consisting of the left and right channels of the receiver (which is assumed to contain stereo sound data)." - - | n leftBuf rightBuf leftIndex rightIndex | - n := self monoSampleCount. - leftBuf := SoundBuffer newMonoSampleCount: n // 2. - rightBuf := SoundBuffer newMonoSampleCount: n // 2. - leftIndex := rightIndex := 0. - 1 to: n by: 2 do: [:i | - leftBuf at: (leftIndex := leftIndex + 1) put: (self at: i). - rightBuf at: (rightIndex := rightIndex + 1) put: (self at: i + 1)]. - ^ Array with: leftBuf with: rightBuf - ! Item was removed: - ----- Method: SoundBuffer>>stereoSampleCount (in category 'accessing') ----- - stereoSampleCount - "Return the number of stereo slices that fit into this SoundBuffer. A stereo 'slice' consists of two 16-bit samples, one for each channel." - - ^ super size - ! Item was removed: - ----- Method: SoundBuffer>>storeExtendedFloat:on: (in category 'utilities') ----- - 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)].! Item was removed: - ----- Method: SoundBuffer>>trimmedThreshold: (in category 'utilities') ----- - trimmedThreshold: threshold - - | start end | - start := self indexOfFirstSampleOver: threshold. - end := self indexOfLastSampleOver: threshold. - start > end ifTrue: [^ SoundBuffer new]. - start := (start - 200) max: 1. - end := (end + 200) min: self size. - ^ self copyFrom: start to: end - ! Item was removed: - ----- Method: SoundBuffer>>writeOnGZIPByteStream: (in category 'objects from disk') ----- - writeOnGZIPByteStream: aStream - - aStream nextPutAllWordArray: self! Item was removed: - Object subclass: #SoundCodec - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !SoundCodec commentStamp: '<historical>' prior: 0! - I am an abstract class that describes the protocol for sound codecs. Each codec (the name stems from "COder/DECoder") describes a particular algorithm for compressing and decompressing sound data. Most sound codecs are called 'lossy' because they lose information; the decompressed sound data is not exactly the same as the original data. - ! Item was removed: - ----- Method: SoundCodec>>bytesPerEncodedFrame (in category 'subclass responsibilities') ----- - bytesPerEncodedFrame - "Answer the number of bytes required to hold one frame of compressed sound data. Answer zero if this codec produces encoded frames of variable size." - - self subclassResponsibility. - ! Item was removed: - ----- Method: SoundCodec>>compressAndDecompress: (in category 'compress/decompress') ----- - compressAndDecompress: aSound - "Compress and decompress the given sound. Useful for testing." - "(MuLawCodec new compressAndDecompress: (SampledSound soundNamed: 'camera')) play" - - ^ (self compressSound: aSound) asSound - ! Item was removed: - ----- Method: SoundCodec>>compressSound: (in category 'compress/decompress') ----- - compressSound: aSound - "Compress the entirety of the given sound with this codec. Answer a CompressedSoundData." - - | compressed channels | - compressed := CompressedSoundData new - codecName: self class name; - soundClassName: aSound class name. - (aSound isKindOf: SampledSound) ifTrue: [ - channels := Array new: 1. - channels at: 1 put: (self encodeSoundBuffer: aSound samples). - compressed - channels: channels; - samplingRate: aSound originalSamplingRate; - firstSample: 1; - loopEnd: aSound samples size; - loopLength: 0.0; - perceivedPitch: 100.0; - gain: aSound loudness. - ^ compressed]. - (aSound isKindOf: LoopedSampledSound) ifTrue: [ - aSound isStereo - ifTrue: [ - channels := Array new: 2. - channels at: 1 put: (self encodeSoundBuffer: aSound leftSamples). - channels at: 2 put: (self encodeSoundBuffer: aSound rightSamples)] - ifFalse: [ - channels := Array new: 1. - channels at: 1 put: (self encodeSoundBuffer: aSound leftSamples)]. - compressed - channels: channels; - samplingRate: aSound originalSamplingRate; - firstSample: aSound firstSample; - loopEnd: aSound loopEnd; - loopLength: aSound loopLength; - perceivedPitch: aSound perceivedPitch; - gain: aSound gain. - ^ compressed]. - self error: 'you can only compress sampled sounds'. - ! Item was removed: - ----- Method: SoundCodec>>compressSound:atRate: (in category 'compress/decompress') ----- - compressSound: aSound atRate: desiredSampleRate - "Compress the entirety of the given sound with this codec. Answer a CompressedSoundData." - - | compressed channels samples newRate ratio buffer | - - compressed := CompressedSoundData new - codecName: self class name; - soundClassName: aSound class name. - (aSound isKindOf: SampledSound) ifTrue: [ - (desiredSampleRate isNil or: - [(ratio := aSound originalSamplingRate // desiredSampleRate) <= 1]) ifTrue: [ - samples := aSound samples. - newRate := aSound originalSamplingRate. - ] ifFalse: [ - buffer := aSound samples. - samples := SoundBuffer - averageEvery: ratio - from: buffer - upTo: buffer monoSampleCount. - newRate := aSound originalSamplingRate / ratio. - ]. - - channels := Array new: 1. - channels at: 1 put: (self encodeSoundBuffer: samples). - compressed - channels: channels; - samplingRate: newRate; - firstSample: 1; - loopEnd: samples size; - loopLength: 0.0; - perceivedPitch: 100.0; - gain: aSound loudness. - ^ compressed]. - (aSound isKindOf: LoopedSampledSound) ifTrue: [ - aSound isStereo - ifTrue: [ - channels := Array new: 2. - channels at: 1 put: (self encodeSoundBuffer: aSound leftSamples). - channels at: 2 put: (self encodeSoundBuffer: aSound rightSamples)] - ifFalse: [ - channels := Array new: 1. - channels at: 1 put: (self encodeSoundBuffer: aSound leftSamples)]. - compressed - channels: channels; - samplingRate: aSound originalSamplingRate; - firstSample: aSound firstSample; - loopEnd: aSound loopEnd; - loopLength: aSound loopLength; - perceivedPitch: aSound perceivedPitch; - gain: aSound gain. - ^ compressed]. - self error: 'you can only compress sampled sounds'. - ! Item was removed: - ----- Method: SoundCodec>>decodeCompressedData: (in category 'private') ----- - decodeCompressedData: aByteArray - "Decode the entirety of the given encoded data buffer with this codec. Answer a monophonic SoundBuffer containing the uncompressed samples." - - | frameCount result increments | - frameCount := self frameCount: aByteArray. - result := SoundBuffer newMonoSampleCount: frameCount * self samplesPerFrame. - self reset. - increments := self decodeFrames: frameCount from: aByteArray at: 1 into: result at: 1. - ((increments first = aByteArray size) and: [increments last = result size]) ifFalse: [ - self error: 'implementation problem; increment sizes should match buffer sizes']. - ^ result - ! Item was removed: - ----- Method: SoundCodec>>decodeFrames:from:at:into:at: (in category 'subclass responsibilities') ----- - 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." - - self subclassResponsibility. - ! Item was removed: - ----- Method: SoundCodec>>decompressSound: (in category 'compress/decompress') ----- - decompressSound: aCompressedSound - "Decompress the entirety of the given compressed sound with this codec and answer the resulting sound." - - | channels sound | - channels := aCompressedSound channels - collect: [:compressed | self decodeCompressedData: compressed]. - 'SampledSound' = aCompressedSound soundClassName ifTrue: [ - sound := SampledSound - samples: channels first - samplingRate: (aCompressedSound samplingRate). - sound loudness: aCompressedSound gain. - ^ sound]. - 'LoopedSampledSound' = aCompressedSound soundClassName ifTrue: [ - aCompressedSound loopLength = 0 - ifTrue: [ - sound := LoopedSampledSound - unloopedSamples: channels first - pitch: aCompressedSound perceivedPitch - samplingRate: aCompressedSound samplingRate] - ifFalse: [ - sound := LoopedSampledSound - samples: channels first - loopEnd: aCompressedSound loopEnd - loopLength: aCompressedSound loopLength - pitch: aCompressedSound perceivedPitch - samplingRate: aCompressedSound samplingRate]. - channels size > 1 ifTrue: [sound rightSamples: channels last]. - sound - firstSample: aCompressedSound firstSample; - gain: aCompressedSound gain. - sound - setPitch: 100.0 - dur: (channels first size / aCompressedSound samplingRate) - loudness: 1.0. - ^ sound]. - self error: 'unknown sound class'. - ! Item was removed: - ----- Method: SoundCodec>>encodeFrames:from:at:into:at: (in category 'subclass responsibilities') ----- - 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." - - self subclassResponsibility. - ! Item was removed: - ----- Method: SoundCodec>>encodeSoundBuffer: (in category 'private') ----- - encodeSoundBuffer: aSoundBuffer - "Encode the entirety of the given monophonic SoundBuffer with this codec. Answer a ByteArray containing the compressed sound data." - - | codeFrameSize frameSize fullFrameCount lastFrameSamples result increments finalFrame i lastIncs | - frameSize := self samplesPerFrame. - fullFrameCount := aSoundBuffer monoSampleCount // frameSize. - lastFrameSamples := aSoundBuffer monoSampleCount - (fullFrameCount * frameSize). - codeFrameSize := self bytesPerEncodedFrame. - codeFrameSize = 0 ifTrue: - ["Allow room for 1 byte per sample for variable-length compression" - codeFrameSize := frameSize]. - lastFrameSamples > 0 - ifTrue: [result := ByteArray new: (fullFrameCount + 1) * codeFrameSize] - ifFalse: [result := ByteArray new: fullFrameCount * codeFrameSize]. - self reset. - increments := self encodeFrames: fullFrameCount from: aSoundBuffer at: 1 into: result at: 1. - lastFrameSamples > 0 ifTrue: [ - finalFrame := SoundBuffer newMonoSampleCount: frameSize. - i := fullFrameCount * frameSize. - 1 to: lastFrameSamples do: [:j | - finalFrame at: j put: (aSoundBuffer at: (i := i + 1))]. - lastIncs := self encodeFrames: 1 from: finalFrame at: 1 into: result at: 1 + increments second. - increments := Array with: increments first + lastIncs first - with: increments second + lastIncs second]. - increments second < result size - ifTrue: [^ result copyFrom: 1 to: increments second] - ifFalse: [^ result] - ! Item was removed: - ----- Method: SoundCodec>>frameCount: (in category 'private') ----- - frameCount: aByteArray - "Compute the frame count for this byteArray. This default computation will have to be overridden by codecs with variable frame sizes." - - | codeFrameSize | - codeFrameSize := self bytesPerEncodedFrame. - (aByteArray size \\ codeFrameSize) = 0 ifFalse: - [self error: 'encoded buffer is not an even multiple of the encoded frame size']. - ^ aByteArray size // codeFrameSize! Item was removed: - ----- Method: SoundCodec>>reset (in category 'subclass responsibilities') ----- - reset - "Reset my encoding and decoding state. Optional. This default implementation does nothing." - ! Item was removed: - ----- Method: SoundCodec>>samplesPerFrame (in category 'subclass responsibilities') ----- - samplesPerFrame - "Answer the number of sound samples per compression frame." - - self subclassResponsibility. - ! Item was removed: - SoundRecorder subclass: #SoundInputStream - instanceVariableNames: 'bufferSize mutex' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !SoundInputStream commentStamp: '<historical>' prior: 0! - This subclass of SoundRecorder supports real-time processing of incoming sound data. The sound input process queues raw sound buffers, allowing them to be read and processed by the client as they become available. A semaphore is used to synchronize between the record process and the client process. Since sound data is buffered, the client process may lag behind the input process without losing data. - ! Item was removed: - ----- Method: SoundInputStream>>allocateBuffer (in category 'private') ----- - allocateBuffer - "Allocate a new buffer and reset nextIndex. This message is sent by the sound input process." - - currentBuffer := SoundBuffer newMonoSampleCount: bufferSize. - nextIndex := 1. - ! Item was removed: - ----- Method: SoundInputStream>>bufferCount (in category 'accessing') ----- - bufferCount - "Answer the number of sound buffers that have been queued." - - mutex ifNil: [^ 0]. "not recording" - ^mutex critical: [recordedBuffers size]. - ! Item was removed: - ----- Method: SoundInputStream>>bufferSize (in category 'accessing') ----- - bufferSize - - ^ bufferSize - ! Item was removed: - ----- Method: SoundInputStream>>bufferSize: (in category 'accessing') ----- - bufferSize: aNumber - "Set the sound buffer size. Buffers of this size will be queued for the client to process." - - bufferSize := aNumber truncated. - ! Item was removed: - ----- Method: SoundInputStream>>emitBuffer: (in category 'private') ----- - emitBuffer: buffer - "Queue a buffer for later processing. This message is sent by the sound input process." - - mutex critical: [recordedBuffers addLast: buffer]. - ! Item was removed: - ----- Method: SoundInputStream>>initialize (in category 'initialization') ----- - initialize - - super initialize. - bufferSize := 1024. - mutex := nil. - ! Item was removed: - ----- Method: SoundInputStream>>isRecording (in category 'accessing') ----- - isRecording - "Answer true if the sound input process is running." - - ^ recordProcess ~~ nil - ! Item was removed: - ----- Method: SoundInputStream>>nextBufferOrNil (in category 'accessing') ----- - nextBufferOrNil - "Answer the next input buffer or nil if no buffer is available." - - mutex ifNil: [^ nil]. "not recording" - ^mutex critical: [ - recordedBuffers size > 0 - ifTrue: [recordedBuffers removeFirst] - ifFalse: [nil]]. - ! Item was removed: - ----- Method: SoundInputStream>>startRecording (in category 'recording controls') ----- - startRecording - "Start the sound input process." - - recordProcess ifNotNil: [self stopRecording]. - recordedBuffers := OrderedCollection new: 100. - mutex := Semaphore forMutualExclusion. - super startRecording. - paused := false. - ! Item was removed: - ----- Method: SoundInputStream>>stopRecording (in category 'recording controls') ----- - stopRecording - "Turn off the sound input process and close the driver." - - super stopRecording. - recordedBuffers := nil. - mutex := nil. - ! Item was removed: - Object subclass: #SoundPlayer - instanceVariableNames: '' - classVariableNames: 'ActiveSounds Buffer BufferIndex BufferMSecs LastBuffer PlayerProcess PlayerSemaphore ReadyForBuffer ReverbState SamplingRate SoundJustStarted SoundSupported SoundsShouldStartQuick SoundsStopWhenDone Stereo UseReadySemaphore UseReverb' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: SoundPlayer class>>boinkPitch:dur:loudness:waveTable:pan: (in category 'primitive test') ----- - boinkPitch: p dur: d loudness: l waveTable: waveTable pan: pan - "Play a decaying note on the given stream using the given wave table. Used for testing only." - - | decay tableSize amplitude increment cycles i | - decay := 0.96. - tableSize := waveTable size. - amplitude := l asInteger min: 1000. - increment := ((p asFloat * tableSize asFloat) / SamplingRate asFloat) asInteger. - increment := (increment max: 1) min: (tableSize // 2). - cycles := (d * SamplingRate asFloat) asInteger. - - i := 1. - 1 to: cycles do: [:cycle | - (cycle \\ 100) = 0 - ifTrue: [amplitude := (decay * amplitude asFloat) asInteger]. - i := (((i - 1) + increment) \\ tableSize) + 1. - self playTestSample: (amplitude * (waveTable at: i)) // 1000 pan: pan]. - ! Item was removed: - ----- Method: SoundPlayer class>>boinkScale (in category 'primitive test') ----- - boinkScale - "Tests the sound output primitives by playing a scale." - "SoundPlayer boinkScale" - - | sineTable pan | - self shutDown: true. - SamplingRate := 11025. - Stereo := true. - sineTable := self sineTable: 1000. - Buffer := SoundBuffer newStereoSampleCount: 1000. - BufferIndex := 1. - self primSoundStartBufferSize: Buffer stereoSampleCount - rate: SamplingRate - stereo: Stereo. - pan := 0. - #(261.626 293.665 329.628 349.229 391.996 440.001 493.884 523.252) do: [:p | - self boinkPitch: p dur: 0.3 loudness: 300 waveTable: sineTable pan: pan. - pan := pan + 125]. - - self boinkPitch: 261.626 dur: 1.0 loudness: 300 waveTable: sineTable pan: 500. - self primSoundStop. - self shutDown: true. - SoundPlayer initialize. "reset sampling rate, buffer size, and stereo flag" - ! Item was removed: - ----- Method: SoundPlayer class>>bufferMSecs (in category 'accessing') ----- - bufferMSecs - - ^ BufferMSecs - ! Item was removed: - ----- Method: SoundPlayer class>>canStartPlayer (in category 'playing') ----- - canStartPlayer - "Some platforms do no support simultaneous record and play. If this is one of those platforms, return false if there is a running SoundRecorder." - - ^SoundRecorder canRecordWhilePlaying - or: [ SoundRecorder anyActive not] - - ! Item was removed: - ----- Method: SoundPlayer class>>defaultQuickStartForPlatform (in category 'preferences') ----- - defaultQuickStartForPlatform - - ^ Smalltalk os platformName = 'Mac OS'. - ! Item was removed: - ----- Method: SoundPlayer class>>defaultStopSoundForPlatform (in category 'preferences') ----- - defaultStopSoundForPlatform - - ^(Smalltalk os platformName = 'Mac OS') not - ! Item was removed: - ----- Method: SoundPlayer class>>initialize (in category 'initialization') ----- - initialize - "SoundPlayer initialize; shutDown; startUp" - "Details: BufferMSecs represents a tradeoff between latency and quality. If BufferMSecs is too low, the sound will not play smoothly, especially during long-running primitives such as large BitBlts. If BufferMSecs is too high, there will be a long time lag between when a sound buffer is submitted to be played and when that sound is actually heard. BufferMSecs is typically in the range 50-200." - - SamplingRate := 22050. - BufferMSecs := 120. - Stereo := true. - UseReverb ifNil: [UseReverb := true]. - ! Item was removed: - ----- Method: SoundPlayer class>>isAllSilence:size: (in category 'private') ----- - isAllSilence: buffer size: count - "return true if the buffer is all silence after reverb has ended" - | value | - value := buffer at: 1. - 2 to: count do:[:i| (buffer at: i) = value ifFalse:[^false]]. - ^true! Item was removed: - ----- Method: SoundPlayer class>>isPlaying: (in category 'playing') ----- - isPlaying: aSound - ^ ActiveSounds includes: aSound! Item was removed: - ----- Method: SoundPlayer class>>isReverbOn (in category 'player process') ----- - isReverbOn - - ^ ReverbState ~~ nil - ! Item was removed: - ----- Method: SoundPlayer class>>lastPlayBuffer (in category 'player process') ----- - lastPlayBuffer - ^LastBuffer! Item was removed: - ----- Method: SoundPlayer class>>oldStylePlayLoop (in category 'player process') ----- - oldStylePlayLoop - "This version of the play loop is used if the VM does not yet support sound primitives that signal a semaphore when a sound buffer becomes available." - - | bytesPerSlice count | - bytesPerSlice := Stereo ifTrue: [4] ifFalse: [2]. - [ - [(count := self primSoundAvailableBytes // bytesPerSlice) > 100] - whileFalse: [(Delay forMilliseconds: 1) wait]. - - count := count min: Buffer stereoSampleCount. - PlayerSemaphore critical: [ - ActiveSounds := ActiveSounds select: [:snd | snd samplesRemaining > 0]. - ActiveSounds do: [:snd | - snd ~~ SoundJustStarted ifTrue: [ - snd playSampleCount: count into: Buffer startingAt: 1]]. - ReverbState == nil ifFalse: [ - ReverbState applyReverbTo: Buffer startingAt: 1 count: count]. - self primSoundPlaySamples: count from: Buffer startingAt: 1. - Buffer primFill: 0. - SoundJustStarted := nil]] repeat - ! Item was removed: - ----- Method: SoundPlayer class>>pauseSound: (in category 'playing') ----- - pauseSound: aSound - "Stop playing the given sound. Playing can be resumed from this point later." - - PlayerSemaphore critical: [ - ActiveSounds remove: aSound ifAbsent: []]. - ! Item was removed: - ----- Method: SoundPlayer class>>playLoop (in category 'player process') ----- - playLoop - "The sound player process loop." - | bytesPerSlice count willStop mayStop | - mayStop := self stopSoundWhenDone. - bytesPerSlice := Stereo ifTrue: [4] ifFalse: [2]. - [ - [(count := self primSoundAvailableBytes // bytesPerSlice) > 100] - whileFalse: [ReadyForBuffer wait]. - - count := count min: Buffer stereoSampleCount. - PlayerSemaphore critical: [ - ActiveSounds := ActiveSounds select: [:snd | snd samplesRemaining > 0]. - ActiveSounds do: [:snd | - snd ~~ SoundJustStarted ifTrue: [ - snd playSampleCount: count into: Buffer startingAt: 1]]. - ReverbState == nil ifFalse: [ - ReverbState applyReverbTo: Buffer startingAt: 1 count: count]. - self primSoundPlaySamples: count from: Buffer startingAt: 1. - willStop := mayStop and:[ - (ActiveSounds size = 0) and:[ - self isAllSilence: Buffer size: count]]. - LastBuffer ifNotNil:[ - LastBuffer replaceFrom: 1 to: LastBuffer size with: Buffer startingAt: 1. - ]. - willStop - ifTrue:[self shutDown: true. PlayerProcess := nil] - ifFalse:[Buffer primFill: 0]. - SoundJustStarted := nil]. - willStop ifTrue:[^self] ] repeat - ! Item was removed: - ----- Method: SoundPlayer class>>playSound: (in category 'playing') ----- - playSound: aSound - "Reset and start playing the given sound from its beginning." - - aSound reset. - aSound samplesRemaining = 0 ifTrue:[^self]. - self resumePlaying: aSound. - ! Item was removed: - ----- Method: SoundPlayer class>>playTestSample:pan: (in category 'primitive test') ----- - playTestSample: s pan: pan - "Append the given sample in the range [-32767..32767] to the output buffer, playing the output buffer when it is full. Used for testing only." - - | sample leftSample | - BufferIndex >= Buffer size - ifTrue: [ - "current buffer is full; play it" - [self primSoundAvailableBytes > 0] - whileFalse. "wait for space to be available" - self primSoundPlaySamples: Buffer stereoSampleCount from: Buffer startingAt: 1. - Buffer primFill: 0. - BufferIndex := 1]. - - sample := s. - sample > 32767 ifTrue: [ sample := 32767 ]. - sample < -32767 ifTrue: [ sample := -32767 ]. - - Stereo - ifTrue: [ - leftSample := (sample * pan) // 1000. - Buffer at: BufferIndex put: sample - leftSample. - Buffer at: BufferIndex + 1 put: leftSample] - ifFalse: [ - Buffer at: BufferIndex + 1 put: sample]. - BufferIndex := BufferIndex + 2. - ! Item was removed: - ----- Method: SoundPlayer class>>playerProcess (in category 'player process') ----- - playerProcess - ^PlayerProcess! Item was removed: - ----- Method: SoundPlayer class>>primGetDefaultSoundPlayer (in category 'private') ----- - primGetDefaultSoundPlayer - "Answer the name of the default output device." - <primitive: 'primitiveGetDefaultSoundPlayer' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primGetDefaultSoundRecorder (in category 'private') ----- - primGetDefaultSoundRecorder - "Answer the name of the default input device." - <primitive: 'primitiveGetDefaultSoundRecorder' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primGetNumberOfSoundPlayerDevices (in category 'private') ----- - primGetNumberOfSoundPlayerDevices - "Answer the number of output devices." - <primitive: 'primitiveGetNumberOfSoundPlayerDevices' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primGetNumberOfSoundRecorderDevices (in category 'private') ----- - primGetNumberOfSoundRecorderDevices - "Answer the number of input devices." - <primitive: 'primitiveGetNumberOfSoundRecorderDevices' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primGetSoundPlayerDeviceName: (in category 'private') ----- - primGetSoundPlayerDeviceName: n - "Answer the name of the n'th output device." - <primitive: 'primitiveGetSoundPlayerDeviceName' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primGetSoundRecorderDeviceName: (in category 'private') ----- - primGetSoundRecorderDeviceName: n - "Answer the name of the n'th input device." - <primitive: 'primitiveGetSoundRecorderDeviceName' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primSetDefaultSoundPlayer: (in category 'private') ----- - primSetDefaultSoundPlayer: deviceName - "Set the default output device by supplying its name." - <primitive: 'primitiveSetDefaultSoundPlayer' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primSetDefaultSoundRecorder: (in category 'private') ----- - primSetDefaultSoundRecorder: deviceName - "Set the default input device by supplying its name." - <primitive: 'primitiveSetDefaultSoundRecorder' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primSoundAvailableBytes (in category 'private') ----- - primSoundAvailableBytes - "Answer the number of bytes of available space in the sound output buffer." - "Note: Squeak always uses buffers containing 4-bytes per sample (2 channels at 2 bytes per channel) regardless of the state of the Stereo flag." - - <primitive: 'primitiveSoundAvailableSpace' module: 'SoundPlugin' error: ec> - ^ self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primSoundEnableAEC: (in category 'private') ----- - primSoundEnableAEC: aBooleanInteger - "Enable or disable acoustic echo-cancellation (AEC). aBooleanInteger should be 0 for false, and 1 for true." - <primitive: 'primitiveSoundEnableAEC' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primSoundGetRecordLevel (in category 'private') ----- - primSoundGetRecordLevel - "Answer sound as array of doubles left then right channel, range is 0.0 to 1.0 but may be overdriven" - <primitive: 'primitiveSoundGetRecordLevel' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>primSoundGetVolume (in category 'private') ----- - primSoundGetVolume - "Answer sound as an array of doubles left then right channel, range is 0.0 to 1.0 but may be overdriven" - <primitive: 'primitiveSoundGetVolume' module: 'SoundPlugin' error: ec> - ^Array with: 1.0 with: 1.0! Item was removed: - ----- Method: SoundPlayer class>>primSoundInsertSamples:from:samplesOfLeadTime: (in category 'private') ----- - primSoundInsertSamples: count from: aSoundBuffer samplesOfLeadTime: anInteger - "Mix the given number of sample frames from the given sound buffer into the queue of samples that has already been submitted to the sound driver. This primitive is used to start a sound playing with minimum latency, even if large sound output buffers are being used to ensure smooth sound output. Answers the number of samples consumed, or zero if the primitive is not implemented or fails." - - <primitive: 'primitiveSoundInsertSamples' module: 'SoundPlugin' error: ec> - ^ 0! Item was removed: - ----- Method: SoundPlayer class>>primSoundPlaySamples:from:startingAt: (in category 'private') ----- - primSoundPlaySamples: count from: aSampleBuffer startingAt: index - "Copy count frames (pairs) of stereo sound samples into the current sound - output buffer from the given sample buffer starting at the given index." - - <primitive: 'primitiveSoundPlaySamples' module: 'SoundPlugin' error: ec> - ^self primitiveFailed - ! Item was removed: - ----- Method: SoundPlayer class>>primSoundSetVolumeLeft:volumeRight: (in category 'private') ----- - primSoundSetVolumeLeft: aLeftVolume volumeRight: aRightVolume - "Set sound pass in float 0.0-1.0 for left and right channel, with possible 2.0 or higher to overdrive sound channel " - <primitive: 'primitiveSoundSetLeftVolume' module: 'SoundPlugin' error: ec> - ^self! Item was removed: - ----- Method: SoundPlayer class>>primSoundStartBufferSize:rate:stereo: (in category 'private') ----- - primSoundStartBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag - "Start double-buffered sound output with the given buffer size and sampling rate. This version has been superceded by primitive 171 (primSoundStartBufferSize:rate:stereo:semaIndex:)." - "ar 12/5/1998 Turn off the sound if not supported" - <primitive: 'primitiveSoundStart' module: 'SoundPlugin' error: ec> - SoundSupported := false! Item was removed: - ----- Method: SoundPlayer class>>primSoundStartBufferSize:rate:stereo:semaIndex: (in category 'private') ----- - primSoundStartBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag semaIndex: anInteger - "Start double-buffered sound output with the given buffer size and sampling rate. If the given semaphore index is > 0, it is taken to be the index of a Semaphore in the external objects array to be signalled when the sound driver is ready to accept another buffer of samples." - "Details: If this primitive fails, this method tries to use the older version instead." - - <primitive: 'primitiveSoundStartWithSemaphore' module: 'SoundPlugin' error: ec> - UseReadySemaphore := false. - self primSoundStartBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag! Item was removed: - ----- Method: SoundPlayer class>>primSoundStop (in category 'private') ----- - primSoundStop - "Stop double-buffered sound output. Must not raise an error because it is used inside error handling and at system shutdown" - - <primitive: 'primitiveSoundStop' module: 'SoundPlugin' error: ec> - ^self! Item was removed: - ----- Method: SoundPlayer class>>primSoundSupportsAEC (in category 'private') ----- - primSoundSupportsAEC - "Answer if the plugin supports echo-cancellation on this OS/hardware." - <primitive: 'primitiveSoundSupportsAEC' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundPlayer class>>resumePlaying: (in category 'playing') ----- - resumePlaying: aSound - "Start playing the given sound without resetting it; it will resume playing from where it last stopped." - "Implementation detail: On virtual machines that don't support the quickstart primitive, you may need to edit this method to pass false to resumePlaying:quickStart:." - - self resumePlaying: aSound quickStart: true. - ! Item was removed: - ----- Method: SoundPlayer class>>resumePlaying:quickStart: (in category 'playing') ----- - resumePlaying: aSound quickStart: quickStart - "Start playing the given sound without resetting it; it will resume playing from where it last stopped. If quickStart is true, then try to start playing the given sound immediately." - - | doQuickStart | - SoundService soundEnabled ifFalse: [^ self]. - doQuickStart := quickStart. - self soundQuickStart ifFalse: [doQuickStart := false]. - PlayerProcess == nil ifTrue: [ - self canStartPlayer ifFalse: [^ self]. - ^self startUpWithSound: aSound]. - - PlayerSemaphore critical: [ - (ActiveSounds includes: aSound) - ifTrue: [doQuickStart := false] - ifFalse: [doQuickStart ifFalse: [ActiveSounds add: aSound]]. - PlayerProcess name: 'Sound Player (', ActiveSounds size asString, ')']. - - "quick-start the given sound, unless the sound player has just started" - doQuickStart ifTrue: [self startPlayingImmediately: aSound]. - ! Item was removed: - ----- Method: SoundPlayer class>>reverbState (in category 'accessing') ----- - reverbState - - ^ ReverbState! Item was removed: - ----- Method: SoundPlayer class>>samplingRate (in category 'accessing') ----- - samplingRate - - ^ SamplingRate! Item was removed: - ----- Method: SoundPlayer class>>setVolumeLeft:volumeRight: (in category 'accessing') ----- - setVolumeLeft: aLeftVolume volumeRight: aRightVolume - "Set sound pass in float 0.0-1.0 for left and right channel, with possible 2.0 or higher to overdrive sound channel " - self primSoundSetVolumeLeft: aLeftVolume volumeRight: aRightVolume! Item was removed: - ----- Method: SoundPlayer class>>shutDown: (in category 'snapshotting') ----- - shutDown: quitting - "Stop player process, for example before snapshotting." - - quitting ifTrue: - [self stopPlayerProcess: false. - ReverbState := nil]! Item was removed: - ----- Method: SoundPlayer class>>sineTable: (in category 'primitive test') ----- - sineTable: size - "Compute a sine table of the given size. Used for testing only." - - | radiansPerStep table | - table := Array new: size. - radiansPerStep := (2.0 * Float pi) / table size asFloat. - 1 to: table size do: [:i | - table at: i put: - (32767.0 * (radiansPerStep * i) sin) asInteger]. - - ^ table - ! Item was removed: - ----- Method: SoundPlayer class>>soundPluginActive (in category 'private') ----- - soundPluginActive - "Answer quickly if the SoundPlugin is actually active." - "self soundPluginActive" - ^SoundSupported - and: [(self class compiledMethodAt: (UseReadySemaphore - ifTrue: [#primSoundStartBufferSize:rate:stereo:semaIndex:] - ifFalse: [#primSoundStartBufferSize:rate:stereo:])) isLinkedNamedPrimitive]! Item was removed: - ----- Method: SoundPlayer class>>soundQuickStart (in category 'preferences') ----- - soundQuickStart - <preference: 'Quickstart Sounds' - category: 'media' - description: 'If true, attempt to start playing sounds immediately rather than waiting for the next chance to fill the sound bufffers"' - type: #Boolean> - - ^SoundsShouldStartQuick ifNil: [self defaultQuickStartForPlatform]! Item was removed: - ----- Method: SoundPlayer class>>soundQuickStart: (in category 'preferences') ----- - soundQuickStart: aBoolean - - - SoundsShouldStartQuick := aBoolean! Item was removed: - ----- Method: SoundPlayer class>>soundVolume (in category 'accessing') ----- - soundVolume - "Return sound as array of doubles left then right channel, range is 0.0 to 1.0 but may be overdriven" - ^self primSoundGetVolume! Item was removed: - ----- Method: SoundPlayer class>>startPlayerProcessBufferSize:rate:stereo: (in category 'player process') ----- - startPlayerProcessBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag - "Start the sound player process. Terminate the old process, if any." - "SoundPlayer startPlayerProcessBufferSize: 1000 rate: 11025 stereo: false" - ^self startPlayerProcessBufferSize: bufferSize - rate: samplesPerSecond - stereo: stereoFlag - sound: nil! Item was removed: - ----- Method: SoundPlayer class>>startPlayerProcessBufferSize:rate:stereo:sound: (in category 'player process') ----- - startPlayerProcessBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag sound: aSound - "Start the sound player process. Terminate the old process, if any." - "SoundPlayer startPlayerProcessBufferSize: 1000 rate: 11025 stereo: false" - - self stopPlayerProcess: true. - aSound ifNotNil: "stopPlayerProcess: ensures ActiveSounds are empty..." - [ActiveSounds add: aSound]. - Buffer := SoundBuffer newStereoSampleCount: (bufferSize // 4) * 4. - LastBuffer ifNotNil: - [LastBuffer := SoundBuffer basicNew: Buffer basicSize]. - PlayerSemaphore := Semaphore forMutualExclusion. - SamplingRate := samplesPerSecond. - Stereo := stereoFlag. - SoundSupported := true. "Assume so" - UseReadySemaphore := true. "set to false if ready semaphore not supported by VM" - Smalltalk newExternalSemaphoreDo: [ :semaphore :index | - ReadyForBuffer := semaphore. - self primSoundStartBufferSize: Buffer stereoSampleCount - rate: samplesPerSecond - stereo: Stereo - semaIndex: index ]. - "Check if sound start prim was successful" - SoundSupported ifFalse:[ - Smalltalk unregisterExternalObject: ReadyForBuffer. - ReadyForBuffer := nil. - ^self ]. - UseReadySemaphore - ifTrue: [PlayerProcess := [SoundPlayer playLoop] newProcess] - ifFalse: [PlayerProcess := [SoundPlayer oldStylePlayLoop] newProcess]. - UseReverb ifTrue: [self startReverb]. - - PlayerProcess - name: 'Sound Player (', ActiveSounds size asString, ')'; - priority: Processor userInterruptPriority; - resume! Item was removed: - ----- Method: SoundPlayer class>>startPlayingImmediately: (in category 'private') ----- - startPlayingImmediately: aSound - "Private!! Start playing the given sound as soon as possible by mixing it into the sound output buffers of the underlying sound driver." - - | totalSamples buf | - "first, fill a double-size buffer with samples" - "Note: The code below assumes that totalSamples contains two - buffers worth of samples, and the insertSamples primitive is - expected to consume at least one buffer's worth of these - samples. The remaining samples are guaranteed to fit into - a single buffer." - totalSamples := Buffer stereoSampleCount * 2. "two buffer's worth" - buf := SoundBuffer newStereoSampleCount: totalSamples. - aSound playSampleCount: totalSamples into: buf startingAt: 1. - ReverbState == nil ifFalse: [ - ReverbState applyReverbTo: buf startingAt: 1 count: totalSamples]. - - PlayerSemaphore critical: [ | n src leftover rest | - "insert as many samples as possible into the sound driver's buffers" - n := self primSoundInsertSamples: totalSamples - from: buf - samplesOfLeadTime: 1024. - n > 0 ifTrue:[ - leftover := totalSamples - n. - - "copy the remainder of buf into Buffer" - "Note: the following loop iterates over 16-bit words, not two-word stereo slices" - "assert: 0 < leftover <= Buffer stereoSampleCount" - src := 2 * n. - 1 to: 2 * leftover do: - [:dst | Buffer at: dst put: (buf at: (src := src + 1))]. - - "generate enough additional samples to finish filling Buffer" - rest := Buffer stereoSampleCount - leftover. - aSound playSampleCount: rest into: Buffer startingAt: leftover + 1. - ReverbState == nil ifFalse: [ - ReverbState applyReverbTo: Buffer startingAt: leftover + 1 count: rest]. - - "record the fact that this sound has already been played into Buffer so that we don't process it again this time around" - SoundJustStarted := aSound. - ] ifFalse:[ - "quick start failed; reset the sound so we start over" - aSound reset. - ]. - ActiveSounds add: aSound]. - ! Item was removed: - ----- Method: SoundPlayer class>>startReverb (in category 'player process') ----- - startReverb - "Start a delay-line style reverb with the given tap delays and gains. Tap delays are given in samples and should be prime integers; the following comment gives an expression that generates primes." - "Integer primesUpTo: 22050" - - UseReverb := true. - ReverbState := ReverbSound new - tapDelays: #(1601 7919) gains: #(0.12 0.07). - ! Item was removed: - ----- Method: SoundPlayer class>>startUp (in category 'snapshotting') ----- - startUp - "Start up the player process." - - SoundPlayer initialize. - SoundPlayer - startPlayerProcessBufferSize: (BufferMSecs * SamplingRate) // 1000 - rate: SamplingRate - stereo: Stereo. - ! Item was removed: - ----- Method: SoundPlayer class>>startUpWithSound: (in category 'snapshotting') ----- - startUpWithSound: aSound - "Start up the player process." - - SoundPlayer initialize. - SoundPlayer - startPlayerProcessBufferSize: (BufferMSecs * SamplingRate) // 1000 - rate: SamplingRate - stereo: Stereo - sound: aSound. - ! Item was removed: - ----- Method: SoundPlayer class>>stereo (in category 'accessing') ----- - stereo - - ^ Stereo - ! Item was removed: - ----- Method: SoundPlayer class>>stopPlayerProcess: (in category 'player process') ----- - stopPlayerProcess: hardStop - "Stop the sound player process." - "SoundPlayer stopPlayerProcess" - - PlayerProcess ifNotNil: - [PlayerProcess ~~ Processor activeProcess ifTrue: - [PlayerProcess terminate]. - PlayerProcess := nil]. - (hardStop or: [self soundPluginActive]) ifTrue: [self primSoundStop]. - ActiveSounds isEmpty ifFalse: - [ActiveSounds := OrderedCollection new]. - Buffer := nil. - PlayerSemaphore isEmpty ifFalse: - [PlayerSemaphore := Semaphore forMutualExclusion]. - ReadyForBuffer ifNotNil: - [Smalltalk unregisterExternalObject: ReadyForBuffer. - ReadyForBuffer := nil]! Item was removed: - ----- Method: SoundPlayer class>>stopPlayingAll (in category 'playing') ----- - stopPlayingAll - "Stop playing all sounds." - - PlayerSemaphore critical: [ - ActiveSounds := ActiveSounds species new]. - ! Item was removed: - ----- Method: SoundPlayer class>>stopReverb (in category 'player process') ----- - stopReverb - - UseReverb := false. - ReverbState := nil. - ! Item was removed: - ----- Method: SoundPlayer class>>stopSoundWhenDone (in category 'preferences') ----- - stopSoundWhenDone - <preference: 'Stop sounds when done' - category: 'media' - description: 'If true, the sound player is shut down after playing finished' - type: #Boolean> - - ^SoundsStopWhenDone ifNil: [self defaultStopSoundForPlatform]! Item was removed: - ----- Method: SoundPlayer class>>stopSoundWhenDone: (in category 'preferences') ----- - stopSoundWhenDone: aBoolean - - SoundsStopWhenDone := aBoolean! Item was removed: - ----- Method: SoundPlayer class>>useLastBuffer (in category 'initialization') ----- - useLastBuffer - ^LastBuffer notNil! Item was removed: - ----- Method: SoundPlayer class>>useLastBuffer: (in category 'initialization') ----- - useLastBuffer: aBool - Buffer ifNil:[^self]. - aBool - ifTrue:[LastBuffer := SoundBuffer basicNew: Buffer basicSize] - ifFalse:[LastBuffer := nil] ! Item was removed: - ----- Method: SoundPlayer class>>useShortBuffer (in category 'initialization') ----- - useShortBuffer - "Experimental support for real-time MIDI input. This only works on platforms whose hardware allows very short buffer sizes. It has been tested on a Macintosh Powerbook G3." - "SoundPlayer useShortBuffer" - - self shutDown: true. - BufferMSecs := 15. - SoundPlayer - startPlayerProcessBufferSize: (BufferMSecs * SamplingRate) // 1000 - rate: SamplingRate - stereo: Stereo. - ! Item was removed: - ----- Method: SoundPlayer class>>waitUntilDonePlaying: (in category 'playing') ----- - waitUntilDonePlaying: aSound - "Wait until the given sound is no longer playing." - - [PlayerSemaphore critical: [ActiveSounds includes: aSound]] - whileTrue: [(Delay forMilliseconds: 100) wait]. - ! Item was removed: - ----- Method: SoundPlayer>>startUp (in category 'system startup') ----- - startUp - - SoundPlayer soundQuickStart: SoundPlayer defaultQuickStartForPlatform. - SoundPlayer stopSoundWhenDone: SoundPlayer defaultStopSoundForPlatform.! Item was removed: - Object subclass: #SoundRecorder - instanceVariableNames: 'stereo samplingRate recordLevel recordedBuffers recordedSound recordProcess bufferAvailableSema paused meteringBuffer meterLevel soundPlaying currentBuffer nextIndex codec desiredSampleRate' - classVariableNames: 'CanRecordWhilePlaying RecorderActive' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: SoundRecorder class>>anyActive (in category 'accessing') ----- - anyActive - "Return true if any sound recorder is actively recording" - ^RecorderActive == true! Item was removed: - ----- Method: SoundRecorder class>>canRecordWhilePlaying (in category 'accessing') ----- - canRecordWhilePlaying - "Return true if this platform supports simultaneous sound recording and playback." - <preference: 'Record while playing' - category: 'media' - description: 'If true, recording and playing sounds concurrently is permitted (platform dependent)' - type: #Boolean> - ^CanRecordWhilePlaying ifNil: [false]. - ! Item was removed: - ----- Method: SoundRecorder class>>canRecordWhilePlaying: (in category 'accessing') ----- - canRecordWhilePlaying: aBoolean - - CanRecordWhilePlaying := aBoolean - ! Item was removed: - ----- Method: SoundRecorder>>allocateBuffer (in category 'private') ----- - allocateBuffer - "Allocate a new buffer and reset nextIndex." - - | bufferTime | - bufferTime := stereo "Buffer time = 1/2 second" - ifTrue: [self samplingRate asInteger] - ifFalse: [self samplingRate asInteger // 2]. - currentBuffer := SoundBuffer newMonoSampleCount: - "Multiple of samplesPerFrame that is approx. bufferTime long" - (bufferTime truncateTo: self samplesPerFrame). - nextIndex := 1. - ! Item was removed: - ----- Method: SoundRecorder>>clearRecordedSound (in category 'recording controls') ----- - clearRecordedSound - "Clear the sound recorded thus far. Go into pause mode if currently recording." - - paused := true. - recordedSound := SequentialSound new. - self allocateBuffer. - ! Item was removed: - ----- Method: SoundRecorder>>codec: (in category 'accessing') ----- - codec: aSoundCodec - - codec := aSoundCodec! Item was removed: - ----- Method: SoundRecorder>>condensedSamples (in category 'results') ----- - condensedSamples - "Return a single SoundBuffer that is the contatenation of all my recorded buffers." - - | sz newBuf i | - recordedBuffers := recordedSound sounds collect: [:snd | snd samples]. - recordedBuffers isEmpty ifTrue: [^ SoundBuffer new: 0]. - recordedBuffers size = 1 ifTrue: [^ recordedBuffers first copy]. - sz := recordedBuffers inject: 0 into: [:tot :buff | tot + buff size]. - newBuf := SoundBuffer newMonoSampleCount: sz. - i := 1. - recordedBuffers do: [:b | - 1 to: b size do: [:j | - newBuf at: i put: (b at: j). - i := i + 1]]. - recordedBuffers := nil. - ^ newBuf - ! Item was removed: - ----- Method: SoundRecorder>>condensedStereoSound (in category 'results') ----- - condensedStereoSound - "Decompose my buffers into left and right channels and return a mixed sound consisting of the those two channels. This may be take a while, since the data must be copied into new buffers." - - | sz leftBuf rightBuf leftI rightI left | - sz := recordedBuffers inject: 0 into: [:tot :buff | tot + buff size]. - leftBuf := SoundBuffer newMonoSampleCount: (sz + 1) // 2. - rightBuf := SoundBuffer newMonoSampleCount: (sz + 1) // 2. - leftI := rightI := 1. - left := true. - recordedBuffers do: [:b | - 1 to: b size do: [:j | - left - ifTrue: [leftBuf at: leftI put: (b at: j). leftI := leftI + 1. left := false] - ifFalse: [rightBuf at: rightI put: (b at: j). rightI := rightI + 1. left := true]]]. - ^ MixedSound new - add: (SampledSound new setSamples: leftBuf samplingRate: samplingRate) pan: 0.0; - add: (SampledSound new setSamples: rightBuf samplingRate: samplingRate) pan: 1.0 - ! Item was removed: - ----- Method: SoundRecorder>>copyFrom:to:normalize:dcOffset: (in category 'trimming') ----- - copyFrom: startPlace to: endPlace normalize: nFactor dcOffset: dcOffset - "Return a new SoundBuffer containing the samples in the given range." - - | startBufIndex startSampleIndex endBufIndex endSampleIndex - count resultBuf j buf firstInBuf n | - startBufIndex := startPlace at: 1. - startSampleIndex := startPlace at: 2. - endBufIndex := endPlace at: 1. - endSampleIndex := endPlace at: 2. - - startBufIndex = endBufIndex - ifTrue: [count := endSampleIndex + 1 - startSampleIndex] - ifFalse: [ - count := ((recordedBuffers at: startBufIndex) size + 1 - startSampleIndex). "first buffer" - count := count + endSampleIndex. "last buffer" - startBufIndex + 1 to: endBufIndex - 1 do: - [:i | count := count + (recordedBuffers at: i) size]]. "middle buffers" - resultBuf := SoundBuffer newMonoSampleCount: count. - - j := 1. "next destination index in resultBuf" - startBufIndex to: endBufIndex do: [:i | - buf := recordedBuffers at: i. - firstInBuf := 1. - n := buf size. - i = startBufIndex ifTrue: [ - n := (recordedBuffers at: startBufIndex) size + 1 - startSampleIndex. - firstInBuf := startSampleIndex]. - i = endBufIndex ifTrue: [ - i = startBufIndex - ifTrue: [n := endSampleIndex + 1 - startSampleIndex] - ifFalse: [n := endSampleIndex]]. - self copyTo: resultBuf from: j to: (j + n - 1) - from: buf startingAt: firstInBuf - normalize: nFactor dcOffset: dcOffset. - j := j + n]. - ^ resultBuf - ! Item was removed: - ----- Method: SoundRecorder>>copyTo:from:to:from:startingAt:normalize:dcOffset: (in category 'trimming') ----- - copyTo: resultBuf from: startIndex to: endIndex from: buf startingAt: firstInBuf normalize: nFactor dcOffset: dcOffset - "Copy samples from buf to resultBuf removing the DC offset and normalizing their volume in the process." - - | indexOffset | - indexOffset := firstInBuf - startIndex. - startIndex to: endIndex do: [:i | - resultBuf at: i put: (((buf at: (i + indexOffset)) - dcOffset) * nFactor) // 1000]. - ! Item was removed: - ----- Method: SoundRecorder>>desiredSampleRate: (in category 'accessing') ----- - desiredSampleRate: newRate - - "use of this method indicates a strong desire for the specified rate, even if - the OS/hardware are not cooperative" - - desiredSampleRate := samplingRate := newRate "Best are 44100 22050 11025" - ! Item was removed: - ----- Method: SoundRecorder>>emitBuffer: (in category 'private') ----- - emitBuffer: buffer - | sound ratio | - - "since some sound recording devices cannot (or will not) record below a certain sample rate, - trim the samples down if the user really wanted fewer samples" - - sound := (desiredSampleRate isNil or: [(ratio := samplingRate // desiredSampleRate) <= 1]) - ifTrue: [SampledSound new setSamples: buffer samplingRate: samplingRate] - ifFalse: - [| resultBuf | - resultBuf := SoundBuffer - averageEvery: ratio - from: buffer - upTo: buffer monoSampleCount. - SampledSound new setSamples: resultBuf samplingRate: samplingRate / ratio]. - recordedSound ifNil: - [recordedSound := SequentialSound new]. - recordedSound add: (codec ifNil: [sound] ifNotNil: [codec compressSound: sound])! Item was removed: - ----- Method: SoundRecorder>>emitPartialBuffer (in category 'private') ----- - emitPartialBuffer - | s | - s := self samplesPerFrame. - self emitBuffer: (currentBuffer copyFrom: 1 to: ((nextIndex-1) +( s-1) truncateTo: s))! Item was removed: - ----- Method: SoundRecorder>>endPlace (in category 'trimming') ----- - endPlace - - ^ Array with: recordedBuffers size with: recordedBuffers last size! Item was removed: - ----- Method: SoundRecorder>>firstSampleOverThreshold:dcOffset:startingAt: (in category 'trimming') ----- - firstSampleOverThreshold: threshold dcOffset: dcOffset startingAt: startPlace - "Beginning at startPlace, this routine will return the first place at which a sample exceeds the given threshold." - - | buf s iStart jStart nThreshold | - nThreshold := threshold negated. - iStart := startPlace first. - jStart := startPlace second. - iStart to: recordedBuffers size do: - [:i | buf := recordedBuffers at: i. - jStart to: buf size do: - [:j | s := (buf at: j) - dcOffset. - (s < nThreshold or: [s > threshold]) ifTrue: - ["found a sample over threshold" - ^ Array with: i with: j]]. - jStart := 1]. - ^ self endPlace! Item was removed: - ----- Method: SoundRecorder>>hasRecordedSound (in category 'recording controls') ----- - hasRecordedSound - "Answer whether the receiver currently has any recorded sound" - - ^ self recordedSound notNil! Item was removed: - ----- Method: SoundRecorder>>initialize (in category 'initialization') ----- - initialize - "SoundRecorder new" - - super initialize. - stereo := false. - samplingRate := 11025. - recordLevel := 0.5. - self initializeRecordingState. - ! Item was removed: - ----- Method: SoundRecorder>>initializeRecordingState (in category 'initialization') ----- - initializeRecordingState - - recordProcess := nil. - bufferAvailableSema := nil. - paused := true. - meteringBuffer := nil. - meterLevel := 0. - soundPlaying := nil. - currentBuffer := nil. - nextIndex := 1. - ! Item was removed: - ----- Method: SoundRecorder>>isActive (in category 'accessing') ----- - isActive - "Return true if I have a recordProcess running." - - ^ recordProcess ~~ nil - ! Item was removed: - ----- Method: SoundRecorder>>isPaused (in category 'accessing') ----- - isPaused - "Return true if recording is paused." - - ^ paused - ! Item was removed: - ----- Method: SoundRecorder>>meterFrom:count:in: (in category 'private') ----- - meterFrom: start count: count in: buffer - "Update the meter level with the maximum signal level in the given range of the given buffer." - - | max sample min | - count = 0 ifTrue: [^self]. "no new samples" - max := min := 0. - start to: start + count - 1 do: - [:i | - sample := buffer at: i. - sample > max - ifTrue: [max := sample] - ifFalse: - [sample < min ifTrue: [min := sample]]]. - meterLevel := max max: min negated! Item was removed: - ----- Method: SoundRecorder>>meterLevel (in category 'accessing') ----- - meterLevel - "Return the meter level, an integer in the range [0..100] where zero is silence and 100 represents the maximum signal level possible without clipping." - - ^ (100 * meterLevel) // 32768 - ! Item was removed: - ----- Method: SoundRecorder>>normalizeFactorFor:min:max:dcOffset: (in category 'trimming') ----- - normalizeFactorFor: percentOfMaxVolume min: min max: max dcOffset: dcOffset - "Return a normalization factor for the range of sample values and DC offset. A normalization factor is a fixed-point number that will be divided by 1000 after multiplication with each sample value." - - | peak factor | - peak := (max - dcOffset) max: (min - dcOffset) negated. - peak = 0 ifTrue: [^ 1000]. - factor := (32767.0 * percentOfMaxVolume) / (100.0 * peak). - ^ (factor * 1000.0) asInteger - ! Item was removed: - ----- Method: SoundRecorder>>pause (in category 'recording controls') ----- - pause - "Go into pause mode. The record level continues to be updated, but no sound is recorded." - - paused := true. - ((currentBuffer ~~ nil) and: [nextIndex > 1]) - ifTrue: [self emitPartialBuffer. - self allocateBuffer]. - - soundPlaying ifNotNil: [ - soundPlaying pause. - soundPlaying := nil]. - "Note: there can be problems if canRecordWhilePlaying is true. Recorders which only pause will inhibit other recorders from recording. I chose to make #stopPlaying unconditional in a subclass. The same might be appropriate here at the expense of making recorders resumable" - - self class canRecordWhilePlaying ifFalse: [self stopRecording].! Item was removed: - ----- Method: SoundRecorder>>place:plus: (in category 'trimming') ----- - place: startPlace plus: nSamples - "Return the place that is nSamples (may be negative) beyond thisPlace." - - | i j remaining buf | - i := startPlace first. - j := startPlace second. - nSamples >= 0 - ifTrue: [remaining := nSamples. - [buf := recordedBuffers at: i. - (j + remaining) <= buf size ifTrue: [^ Array with: i with: j + remaining]. - i < recordedBuffers size] - whileTrue: [remaining := remaining - (buf size - j + 1). - i := i+1. j := 1]. - ^ self endPlace] - ifFalse: [remaining := nSamples negated. - [buf := recordedBuffers at: i. - (j - remaining) >= 1 ifTrue: [^ Array with: i with: j - remaining]. - i > 1] - whileTrue: [remaining := remaining - j. - i := i-1. j := (recordedBuffers at: i) size]. - ^ #(1 1)]! Item was removed: - ----- Method: SoundRecorder>>playback (in category 'recording controls') ----- - playback - "Playback the sound that has been recorded." - - self pause. - soundPlaying := self recordedSound. - soundPlaying play. - ! Item was removed: - ----- Method: SoundRecorder>>primGetActualRecordingSampleRate (in category 'primitives') ----- - primGetActualRecordingSampleRate - "Answer the actual sample rate being used for recording. This primitive fails unless sound recording is currently in progress." - - <primitive: 'primitiveSoundGetRecordingSampleRate' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundRecorder>>primRecordSamplesInto:startingAt: (in category 'primitives') ----- - primRecordSamplesInto: aWordArray startingAt: index - "Record a sequence of 16-bit sound samples into the given array starting at the given sample index. Answer the number of samples recorded, which may be zero if no samples are currently available." - - <primitive: 'primitiveSoundRecordSamples' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundRecorder>>primSetRecordLevel: (in category 'primitives') ----- - primSetRecordLevel: anInteger - "Set the desired recording level to the given value in the range 0-1000, where 0 is the lowest recording level and 1000 is the maximum. Do nothing if the sound input hardware does not support changing the recording level." - - <primitive: 'primitiveSoundSetRecordLevel' module: 'SoundPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: SoundRecorder>>primStartRecordingDesiredSampleRate:stereo:semaIndex: (in category 'primitives') ----- - primStartRecordingDesiredSampleRate: samplesPerSec stereo: stereoFlag semaIndex: anInteger - "Start sound recording with the given stereo setting. Use a sampling rate as close to the desired rate as the underlying platform will support. If the given semaphore index is > 0, it is taken to be the index of a Semaphore in the external objects array to be signalled every time a recording buffer is filled. - We do *not* raise a primitiveFailed error here since this prim is called insdied a critical blcok and that often makes things painful. The only really likely case where this prim fails is a linux machine with no sound input hardware (a Raspberry Pi for example). See the startRecording method for how the failure is handled" - - <primitive: 'primitiveSoundStartRecording' module: 'SoundPlugin'> - "self primitiveFailed" - ! Item was removed: - ----- Method: SoundRecorder>>primStopRecording (in category 'primitives') ----- - primStopRecording - "Stop sound recording. Does nothing if recording is not currently in progress. Do not fail if plugin is not available" - - <primitive: 'primitiveSoundStopRecording' module: 'SoundPlugin'>! Item was removed: - ----- Method: SoundRecorder>>recordLevel (in category 'accessing') ----- - recordLevel - - ^ recordLevel - ! Item was removed: - ----- Method: SoundRecorder>>recordLevel: (in category 'accessing') ----- - recordLevel: level - "Set the desired recording level to the given value in the range 0.0 to 1.0, where 0.0 is the lowest recording level and 1.0 is the maximum. Do nothing if the sound input hardware does not support changing the recording level." - "Details: On the Macintosh, the lowest possible record level attenuates the input signal, but does not silence it entirely." - - recordLevel := (level asFloat min: 1.0) max: 0.0. - recordProcess ifNotNil: [ - self primSetRecordLevel: (1000.0 * recordLevel) asInteger]. - ! Item was removed: - ----- Method: SoundRecorder>>recordLoop (in category 'private') ----- - recordLoop - "Record process loop that records samples." - - | n sampleCount linuxWorkaroundBlock | - - n := 0. - linuxWorkaroundBlock := Smalltalk os platformName = 'unix' - ifTrue: [ [ (Delay forMilliseconds: 20) wait ] ] - ifFalse: [ nil ]. - [ - n = 0 ifTrue: [bufferAvailableSema wait]. - paused - ifTrue: [ - n := self primRecordSamplesInto: meteringBuffer startingAt: 1. - self meterFrom: 1 count: n in: meteringBuffer] - ifFalse: [ - n := self primRecordSamplesInto: currentBuffer startingAt: nextIndex. - self meterFrom: nextIndex count: n in: currentBuffer. - nextIndex := nextIndex + n. - stereo - ifTrue: [sampleCount := currentBuffer stereoSampleCount] - ifFalse: [sampleCount := currentBuffer monoSampleCount]. - nextIndex > sampleCount - ifTrue: [ - self emitBuffer: currentBuffer. - self allocateBuffer]]. - - "workaround for OSS emulation on top on ALSA (on Linux environments)" - linuxWorkaroundBlock ifNotNil: [ linuxWorkaroundBlock value ] ] repeat - ! Item was removed: - ----- Method: SoundRecorder>>recordedSound (in category 'results') ----- - recordedSound - "Return the sound that was recorded." - - ^ recordedSound - ! Item was removed: - ----- Method: SoundRecorder>>resumeRecording (in category 'recording controls') ----- - resumeRecording - "Continue recording from the point at which it was last paused." - - self flag: #bob. - "Note: If canRecordWhilePlaying is true, then recordings may never get started (at least by this method). One possibility, used in a subclass, is to make the #startPlaying unconditional. Another would be to use #startPlaying instead of #resumePlaying in appropriate cases" - - self class canRecordWhilePlaying ifFalse: [self startRecording]. - paused := false. - ! Item was removed: - ----- Method: SoundRecorder>>samplesPerFrame (in category 'private') ----- - samplesPerFrame - "Can be overridden to quantize buffer size for, eg, fixed-frame codecs" - - codec == nil - ifTrue: [^ 1] - ifFalse: [^ codec samplesPerFrame]! Item was removed: - ----- Method: SoundRecorder>>samplingRate (in category 'accessing') ----- - samplingRate - - ^ samplingRate - ! Item was removed: - ----- Method: SoundRecorder>>samplingRate: (in category 'accessing') ----- - samplingRate: newRate - - samplingRate := newRate "Best are 44100 22050 11025" - ! Item was removed: - ----- Method: SoundRecorder>>scanForEndThreshold:dcOffset:minLull:startingAt: (in category 'trimming') ----- - scanForEndThreshold: threshold dcOffset: dcOffset minLull: lull startingAt: startPlace - "Beginning at startPlace, this routine will find the last sound that exceeds threshold, such that if you look lull samples later you will not find another sound over threshold within the following block of lull samples. - Return the place that is lull samples beyond to that last sound. - If no end of sound is found, return endPlace." - - | buf s iStart jStart nThreshold n | - nThreshold := threshold negated. - iStart := startPlace first. - jStart := startPlace second. - n := 0. - iStart to: recordedBuffers size do: - [:i | buf := recordedBuffers at: i. - jStart to: buf size do: - [:j | s := (buf at: j) - dcOffset. - (s < nThreshold or: [s > threshold]) - ifTrue: ["found a sample over threshold" - n := 0] - ifFalse: ["still not over threshold" - n := n + 1. - n >= lull ifTrue: [^ Array with: i with: j]]]. - jStart := 1]. - ^ self endPlace! Item was removed: - ----- Method: SoundRecorder>>scanForStartThreshold:dcOffset:minDur:startingAt: (in category 'trimming') ----- - scanForStartThreshold: threshold dcOffset: dcOffset minDur: duration startingAt: startPlace - "Beginning at startPlace, this routine will find the first sound that exceeds threshold, such that if you look duration samples later you will find another sound over threshold within the following block of duration samples. - Return the place that is duration samples prior to that first sound. - If no sound is found, return endPlace." - - | soundPlace lookPlace nextSoundPlace thirdPlace | - soundPlace := self firstSampleOverThreshold: threshold dcOffset: dcOffset - startingAt: startPlace. - [soundPlace = self endPlace ifTrue: [^ soundPlace]. - "Found a sound -- look duration later" - lookPlace := self place: soundPlace plus: duration. - nextSoundPlace := self firstSampleOverThreshold: threshold dcOffset: dcOffset - startingAt: lookPlace. - thirdPlace := self place: lookPlace plus: duration. - nextSoundPlace first < thirdPlace first - or: [nextSoundPlace first = thirdPlace first - and: [nextSoundPlace second < thirdPlace second]]] - whileFalse: [soundPlace := nextSoundPlace]. - - "Yes, there is sound in the next interval as well" - ^ self place: soundPlace plus: 0-duration - ! Item was removed: - ----- Method: SoundRecorder>>segmentsAbove:normalizedVolume: (in category 'trimming') ----- - segmentsAbove: threshold normalizedVolume: percentOfMaxVolume - "Break the current recording up into a sequence of sound segments separated by silences." - - | dcOffset firstPlace endPlace resultBuf nFactor lastPlace segments gapSize minDur minLull soundSize restSize max min sum totalSamples | - stereo ifTrue: [self error: 'stereo trimming is not yet supported']. - paused ifFalse: [self error: 'must stop recording before trimming']. - (recordedSound == nil or: [recordedSound sounds isEmpty]) ifTrue:[^ self]. - "Reconstruct buffers so old trimming code will work" - recordedBuffers := recordedSound sounds collect: [:snd | snd samples]. - soundSize := restSize := 0. - - max := min := sum := totalSamples := 0. - recordedBuffers do: [:buf | | bufSize s | - bufSize := buf size. - totalSamples := totalSamples + buf size. - 1 to: bufSize do: [:i | - s := buf at: i. - s > max ifTrue: [max := s]. - s < min ifTrue: [min := s]. - sum := sum + s]]. - dcOffset := sum // totalSamples. - - minDur := (samplingRate/20.0) asInteger. " 1/20 second " - minLull := (samplingRate/4.0) asInteger. " 1/2 second " - segments := SequentialSound new. - endPlace := self endPlace. - lastPlace := #(1 1). - [firstPlace := self scanForStartThreshold: threshold - dcOffset: dcOffset - minDur: minDur - startingAt: lastPlace. - firstPlace = endPlace] - whileFalse: - [firstPlace = lastPlace ifFalse: - ["Add a silence equal to the gap size" - "Wasteful but simple way to get gap size..." - gapSize := (self copyFrom: lastPlace to: firstPlace - normalize: 1000 dcOffset: dcOffset) size - 2. - "... -2 makes up for overlap of one sample on either end" - segments add: (RestSound dur: gapSize asFloat / samplingRate). - restSize := restSize + gapSize. - "Transcript cr; print: firstPlace; space; print: lastPlace; space; print: gapSize; space; show: 'gap'." - ]. - lastPlace := self scanForEndThreshold: threshold - dcOffset: dcOffset - minLull: minLull + minDur - startingAt: firstPlace. - "Allow room for lead time of next sound" - lastPlace := self place: lastPlace plus: minDur negated. - nFactor := self normalizeFactorFor: percentOfMaxVolume - min: min max: max dcOffset: dcOffset. - resultBuf := self copyFrom: firstPlace to: lastPlace - normalize: nFactor dcOffset: dcOffset. - soundSize := soundSize + resultBuf size. - "Transcript cr; print: firstPlace; space; print: lastPlace; space; print: resultBuf size; space; show: 'sound'." - segments add: (codec == nil - ifTrue: [SampledSound new setSamples: resultBuf samplingRate: samplingRate] - ifFalse: [codec compressSound: (SampledSound new setSamples: resultBuf samplingRate: samplingRate)])]. - - "Final gap for consistency" - gapSize := (self copyFrom: lastPlace to: self endPlace - normalize: 1000 dcOffset: dcOffset) size - 1. - segments add: (RestSound dur: gapSize asFloat / samplingRate). - restSize := restSize + gapSize. - self inform: (soundSize+restSize/samplingRate printShowingMaxDecimalPlaces: 1) , ' secs reduced to ' , (soundSize/samplingRate printShowingMaxDecimalPlaces: 1). - recordedBuffers := nil. - ^ segments! Item was removed: - ----- Method: SoundRecorder>>soundSegments (in category 'results') ----- - soundSegments - - ^ self segmentsAbove: 1000 normalizedVolume: 80.0 - ! Item was removed: - ----- Method: SoundRecorder>>startRecording (in category 'recording controls') ----- - startRecording - "Turn on the sound input driver and start the recording process. Initially, recording is paused. - If the primStartRecordingDesiredSampleRate:... fails it almost certainly means we have no usable - sound input device. Rather than having the prim raise a failure error we let it quietly do nothing - (since I hate trying to debug errors inside a critical block) and check the actual sampling rate later. - If the sampling rate is 0 we know the startup failed and raise an application level Signal to let any - user code know about the problem. - You might think we should also use the stopRecording message to close things down cleanly but - that simply results in astorm of attempts to start recording so it is simpler to let it be deluded. An - attempts to start recording will repeat the test and thereby handle any plug-in hardware etc." - - recordLevel ifNil: [recordLevel := 0.5]. "lazy initialization" - self class canRecordWhilePlaying ifFalse: [SoundPlayer shutDown: true]. - recordProcess ifNotNil: [self stopRecording]. - paused := true. - meteringBuffer := SoundBuffer newMonoSampleCount: 1024. - meterLevel := 0. - self allocateBuffer. - Smalltalk newExternalSemaphoreDo: [ :semaphore :index | - bufferAvailableSema := semaphore. - self primStartRecordingDesiredSampleRate: samplingRate asInteger - stereo: stereo - semaIndex: index ]. - RecorderActive := true. - samplingRate := self primGetActualRecordingSampleRate. - samplingRate = 0 ifTrue: [ Warning signal: 'SoundRecorder: unable to connect to sound input device']. - self primSetRecordLevel: (1000.0 * recordLevel) asInteger. - recordProcess := [self recordLoop] newProcess. - recordProcess priority: Processor userInterruptPriority. - recordProcess resume! Item was removed: - ----- Method: SoundRecorder>>stopRecording (in category 'recording controls') ----- - stopRecording - "Stop the recording process and turn of the sound input driver." - - recordProcess ifNotNil: [recordProcess terminate]. - recordProcess := nil. - self primStopRecording. - RecorderActive := false. - Smalltalk unregisterExternalObject: bufferAvailableSema. - ((currentBuffer ~~ nil) and: [nextIndex > 1]) - ifTrue: [self emitPartialBuffer]. - codec ifNotNil: [codec reset]. - self initializeRecordingState. - ! Item was removed: - ----- Method: SoundRecorder>>suppressSilence (in category 'trimming') ----- - suppressSilence - - recordedSound := self soundSegments! Item was removed: - ----- Method: SoundRecorder>>trim:normalizedVolume: (in category 'trimming') ----- - trim: threshold normalizedVolume: percentOfMaxVolume - "Remove the leading and trailing parts of this recording that are below the given threshold. Remove any DC offset and scale the recording so that its peaks are the given percent of the maximum volume." - - | dcOffset startPlace endPlace resultBuf nFactor max min sum totalSamples | - stereo ifTrue: [self error: 'stereo trimming is not yet supported']. - paused ifFalse: [self error: 'must stop recording before trimming']. - recordedBuffers := recordedSound sounds collect: [:snd | snd samples]. - recordedBuffers isEmpty ifTrue: [^ self]. - - max := min := sum := totalSamples := 0. - recordedBuffers do: [:buf | | bufSize s | - bufSize := buf size. - totalSamples := totalSamples + buf size. - 1 to: bufSize do: [:i | - s := buf at: i. - s > max ifTrue: [max := s]. - s < min ifTrue: [min := s]. - sum := sum + s]]. - dcOffset := sum // totalSamples. - - "a place is an array of <buffer index><index of sample in buffer>" - startPlace := self scanForStartThreshold: threshold - dcOffset: dcOffset - minDur: (samplingRate/60.0) asInteger "at least 1/60th of a second" - startingAt: #(1 1). - startPlace = self endPlace ifTrue: - ["no samples above threshold" - recordedBuffers := nil. ^ self]. - - endPlace := self scanForEndThreshold: threshold - dcOffset: dcOffset - minLull: (samplingRate/5) asInteger - startingAt: startPlace. - nFactor := self normalizeFactorFor: percentOfMaxVolume min: min max: max dcOffset: dcOffset. - resultBuf := self copyFrom: startPlace to: endPlace normalize: nFactor dcOffset: dcOffset. - recordedSound := SampledSound new setSamples: resultBuf samplingRate: samplingRate. - recordedBuffers := nil - ! Item was removed: - ----- Method: SoundRecorder>>verifyExistenceOfRecordedSound (in category 'recording controls') ----- - verifyExistenceOfRecordedSound - "If the receiver has a recorded sound, answer true; if not, put up an informer and answer false" - - ^ self recordedSound - ifNotNil: - [true] - ifNil: - [self inform: 'please record a sound first' translated. - false]! Item was removed: - AbstractSound subclass: #StreamingMonoSound - instanceVariableNames: 'stream volume repeat headerStart audioDataStart streamSamplingRate totalSamples codec mixer leftoverSamples lastBufferMSecs mutex' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !StreamingMonoSound commentStamp: '<historical>' prior: 0! - I implement a streaming player for monophonic Sun (.au) and AIFF (.aif) audio files. - Example of use: - (StreamingMonoSound onFileNamed: 'song.aif') play. - ! Item was removed: - ----- Method: StreamingMonoSound class>>onFileNamed: (in category 'instance creation') ----- - onFileNamed: fileName - "Answer an instance of me for playing the file with the given name." - - | f | - f := FileDirectory default readOnlyFileNamed: fileName. - f ifNil: [^ self error: 'could not open ', fileName]. - ^ self new initStream: f headerStart: 0 - ! Item was removed: - ----- Method: StreamingMonoSound class>>onFileNamed:headerStart: (in category 'instance creation') ----- - onFileNamed: fileName headerStart: anInteger - "Answer an instance of me for playing audio data starting at the given position in the file with the given name." - - | f | - f := FileDirectory default readOnlyFileNamed: fileName. - f ifNil: [^ self error: 'could not open ', fileName]. - ^ self new initStream: f headerStart: anInteger - ! Item was removed: - ----- Method: StreamingMonoSound>>closeFile (in category 'other') ----- - closeFile - "Close my stream, if it responds to close." - - stream ifNotNil: [ - (stream respondsTo: #close) ifTrue: [stream close]]. - mixer := nil. - codec := nil. - ! Item was removed: - ----- Method: StreamingMonoSound>>createMixer (in category 'private') ----- - createMixer - "Create a mixed sound consisting of sampled sounds with one sound buffer's worth of samples." - - | snd | - mixer := MixedSound new. - snd := SampledSound - samples: (SoundBuffer newMonoSampleCount: 2) "buffer size will be adjusted dynamically" - samplingRate: streamSamplingRate. - mixer add: snd pan: 0.5 volume: volume. - ! Item was removed: - ----- Method: StreamingMonoSound>>currentSampleIndex (in category 'private') ----- - currentSampleIndex - "Answer the index of the current sample." - - | bytePosition frameIndex | - bytePosition := stream position - audioDataStart. - codec - ifNil: [^ bytePosition // 2] - ifNotNil: [ - frameIndex := bytePosition // codec bytesPerEncodedFrame. - ^ (frameIndex * codec samplesPerFrame) - leftoverSamples monoSampleCount]. - ! Item was removed: - ----- Method: StreamingMonoSound>>duration (in category 'accessing') ----- - duration - "Answer the duration of this sound in seconds." - - ^ totalSamples asFloat / streamSamplingRate - ! Item was removed: - ----- Method: StreamingMonoSound>>extractFrom:to: (in category 'other') ----- - extractFrom: startSecs to: endSecs - "Extract a portion of this sound between the given start and end times. The current implementation only works if the sound is uncompressed." - - | emptySound first last sampleCount byteStream sndBuf | - codec ifNotNil: [^ self error: 'only works on uncompressed sounds']. - emptySound := SampledSound samples: SoundBuffer new samplingRate: streamSamplingRate. - first := (startSecs * streamSamplingRate) truncated max: 0. - last := ((endSecs * streamSamplingRate) truncated min: totalSamples) - 1. - first >= last ifTrue: [^ emptySound]. - codec ifNotNil: [self error: 'extracting from compressed sounds is not supported']. - sampleCount := last + 1 - first. - stream position: audioDataStart + (2 * first). - byteStream := ReadStream on: (stream next: 2 * sampleCount). - sndBuf := SoundBuffer newMonoSampleCount: sampleCount. - 1 to: sampleCount do: [:i | sndBuf at: i put: byteStream int16]. - ^ SampledSound samples: sndBuf samplingRate: streamSamplingRate - ! Item was removed: - ----- Method: StreamingMonoSound>>initStream:headerStart: (in category 'initialization') ----- - initStream: aStream headerStart: anInteger - "Initialize for streaming from the given stream. The audio file header starts at the given stream position." - - stream := aStream. - volume := 1.0. - repeat := false. - headerStart := anInteger. - self reset. - ! Item was removed: - ----- Method: StreamingMonoSound>>loadBuffer:compressedSampleCount: (in category 'private') ----- - loadBuffer: aSoundBuffer compressedSampleCount: sampleCount - "Load the given sound buffer from the compressed sample stream." - "Details: Most codecs decode in multi-sample units called 'frames'. Since the requested sampleCount is typically not an even multiple of the frame size, we need to deal with partial frames. The unused samples from a partial frame are retained until the next call to this method." - - | n samplesNeeded frameCount encodedBytes r decodedCount buf j | - "first, use any leftover samples" - n := self loadFromLeftovers: aSoundBuffer sampleCount: sampleCount. - samplesNeeded := sampleCount - n. - samplesNeeded <= 0 ifTrue: [^ self]. - - "decode an integral number of full compression frames" - frameCount := samplesNeeded // codec samplesPerFrame. - encodedBytes := stream next: (frameCount * codec bytesPerEncodedFrame). - r := codec decodeFrames: frameCount from: encodedBytes at: 1 into: aSoundBuffer at: n + 1. - decodedCount := r last. - decodedCount >= samplesNeeded ifTrue: [^ self]. - - "decode one last compression frame to finish filling the buffer" - buf := SoundBuffer newMonoSampleCount: codec samplesPerFrame. - encodedBytes := stream next: codec bytesPerEncodedFrame. - codec decodeFrames: 1 from: encodedBytes at: 1 into: buf at: 1. - j := 0. - (n + decodedCount + 1) to: sampleCount do: [:i | - aSoundBuffer at: i put: (buf at: (j := j + 1))]. - - "save the leftover samples" - leftoverSamples := buf copyFrom: (j + 1) to: buf monoSampleCount. - ! Item was removed: - ----- Method: StreamingMonoSound>>loadBuffer:uncompressedSampleCount: (in category 'private') ----- - loadBuffer: aSoundBuffer uncompressedSampleCount: sampleCount - "Load the given sound buffer from the uncompressed sample stream." - - "read directly into the sample buffer; count is in 32-bit words" - stream next: sampleCount // 2 into: aSoundBuffer startingAt: 1. - aSoundBuffer restoreEndianness. - - "read the final sample if sampleCount is odd:" - sampleCount odd ifTrue: [aSoundBuffer at: sampleCount put: stream int16]. - ! Item was removed: - ----- Method: StreamingMonoSound>>loadBuffersForSampleCount: (in category 'private') ----- - loadBuffersForSampleCount: count - "Load the sound buffers from the stream." - - | snd buf sampleCount | - snd := mixer sounds first. - buf := snd samples. - buf monoSampleCount = count ifFalse: [ - buf := SoundBuffer newMonoSampleCount: count. - snd setSamples: buf samplingRate: streamSamplingRate]. - sampleCount := count min: (totalSamples - self currentSampleIndex). - sampleCount < count ifTrue: [buf primFill: 0]. - - codec - ifNil: [self loadBuffer: buf uncompressedSampleCount: sampleCount] - ifNotNil: [self loadBuffer: buf compressedSampleCount: sampleCount]. - - mixer reset. - ! Item was removed: - ----- Method: StreamingMonoSound>>loadFromLeftovers:sampleCount: (in category 'private') ----- - loadFromLeftovers: aSoundBuffer sampleCount: sampleCount - "Load the given sound buffer from the samples leftover from the last frame. Answer the number of samples loaded, which typically is less than sampleCount." - - | leftoverCount n | - leftoverCount := leftoverSamples monoSampleCount. - leftoverCount = 0 ifTrue: [^ 0]. - - n := leftoverCount min: sampleCount. - 1 to: n do: [:i | aSoundBuffer at: i put: (leftoverSamples at: i)]. - n < sampleCount - ifTrue: [leftoverSamples := SoundBuffer new] - ifFalse: [leftoverSamples := leftoverSamples copyFrom: n + 1 to: leftoverSamples size]. - ^ n - ! Item was removed: - ----- Method: StreamingMonoSound>>millisecondsSinceStart (in category 'playing') ----- - millisecondsSinceStart - "Answer the number of milliseconds of this sound started playing." - - | mSecs | - (stream isNil or: [stream closed]) ifTrue: [^ 0]. - mSecs := self currentSampleIndex * 1000 // streamSamplingRate. - (self isPlaying and: [lastBufferMSecs > 0]) ifTrue: [ - "adjust mSecs by the milliseconds since the last buffer" - mutex critical: [ - mSecs := self currentSampleIndex * 1000 // streamSamplingRate. - mSecs := mSecs + ((Time millisecondClockValue - lastBufferMSecs) max: 0)]]. - ^ mSecs + 350 - (2 * SoundPlayer bufferMSecs) - ! Item was removed: - ----- Method: StreamingMonoSound>>playSampleCount:into:startingAt: (in category 'playing') ----- - playSampleCount: n into: aSoundBuffer startingAt: startIndex - "Mix the next n samples of this sound into the given buffer starting at the given index" - - self repeat ifTrue: [ "loop if necessary" - (totalSamples - self currentSampleIndex) < n ifTrue: [self startOver]]. - - mutex critical: [ - lastBufferMSecs := Time millisecondClockValue. - self loadBuffersForSampleCount: (n * streamSamplingRate) // SoundPlayer samplingRate. - mixer playSampleCount: n into: aSoundBuffer startingAt: startIndex]. - ! Item was removed: - ----- Method: StreamingMonoSound>>positionCodecTo: (in category 'private') ----- - positionCodecTo: desiredSampleIndex - "Position to the closest frame before the given sample index when using a codec. If using the ADPCM codec, try to ensure that it is in sync with the compressed sample stream." - - | desiredFrameIndex desiredPosition tmpStream tmpCodec byteBuf bufFrames sampleBuf frameCount n startOffset | - (codec isKindOf: ADPCMCodec) ifFalse: [ - "stateless codecs (or relatively stateless ones, like GSM: just jump to frame boundary" - desiredFrameIndex := desiredSampleIndex // codec samplesPerFrame. - stream position: audioDataStart + (desiredFrameIndex * codec bytesPerEncodedFrame). - codec reset. - ^ self]. - - "compute the desired stream position" - desiredFrameIndex := desiredSampleIndex // codec samplesPerFrame. - desiredPosition := audioDataStart + (desiredFrameIndex * codec bytesPerEncodedFrame). - - "copy stream and codec" - (stream isKindOf: FileStream) - ifTrue: [tmpStream := (FileStream readOnlyFileNamed: stream name) binary] - ifFalse: [tmpStream := stream deepCopy]. - tmpCodec := codec copy reset. - - "reset the codec and start back about 30 seconds to try to get codec in sync" - startOffset := ((desiredFrameIndex - 80000) max: 0) * codec bytesPerEncodedFrame. - tmpStream position: audioDataStart + startOffset. - - "decode forward to the desired position" - byteBuf := ByteArray new: (32000 roundTo: codec bytesPerEncodedFrame). - bufFrames := byteBuf size // codec bytesPerEncodedFrame. - sampleBuf := SoundBuffer newMonoSampleCount: bufFrames * codec samplesPerFrame. - frameCount := (desiredPosition - tmpStream position) // codec bytesPerEncodedFrame. - [frameCount > 0] whileTrue: [ - n := bufFrames min: frameCount. - tmpStream next: n * codec bytesPerEncodedFrame into: byteBuf startingAt: 1. - tmpCodec decodeFrames: n from: byteBuf at: 1 into: sampleBuf at: 1. - frameCount := frameCount - n]. - - codec := tmpCodec. - stream position: tmpStream position. - (tmpStream isKindOf: FileStream) ifTrue: [tmpStream close].! Item was removed: - ----- Method: StreamingMonoSound>>readAIFFHeader (in category 'private') ----- - readAIFFHeader - "Read an AIFF file header from stream." - - | aiffReader | - aiffReader := AIFFFileReader new. - aiffReader readFromStream: stream mergeIfStereo: false skipDataChunk: true. - aiffReader channelCount = 1 ifFalse: [self error: 'not monophonic']. - aiffReader bitsPerSample = 16 ifFalse: [self error: 'not 16-bit']. - - audioDataStart := headerStart + aiffReader channelDataOffset. - streamSamplingRate := aiffReader samplingRate. - totalSamples := aiffReader frameCount min: (stream size - audioDataStart) // 2. - codec := nil. - ! Item was removed: - ----- Method: StreamingMonoSound>>readHeader (in category 'private') ----- - readHeader - "Read the sound file header from my stream." - - | id | - stream position: headerStart. - id := (stream next: 4) asString. - stream position: headerStart. - id = '.snd' ifTrue: [^ self readSunAudioHeader]. - id = 'FORM' ifTrue: [^ self readAIFFHeader]. - self error: 'unrecognized sound file format'. - ! Item was removed: - ----- Method: StreamingMonoSound>>readSunAudioHeader (in category 'private') ----- - readSunAudioHeader - "Read a Sun audio file header from my stream." - - | id headerBytes dataBytes format channelCount | - id := (stream next: 4) asString. - headerBytes := stream uint32. "header bytes" - dataBytes := stream uint32. - format := stream uint32. - streamSamplingRate := stream uint32. - channelCount := stream uint32. - - id = '.snd' ifFalse: [self error: 'not Sun audio format']. - dataBytes := dataBytes min: (stream size - headerBytes). - channelCount = 1 ifFalse: [self error: 'not monophonic']. - audioDataStart := headerStart + headerBytes. - codec := nil. - format = 1 ifTrue: [ "8-bit u-LAW" - codec := MuLawCodec new. - totalSamples := dataBytes. - ^ self]. - format = 3 ifTrue: [ "16-bit linear" - totalSamples := dataBytes // 2. - ^ self]. - format = 23 ifTrue: [ "ADPCM-4 bit (CCITT G.721)" - codec := ADPCMCodec new - initializeForBitsPerSample: 4 samplesPerFrame: 0. - totalSamples := (dataBytes // 4) * 8. - ^ self]. - format = 25 ifTrue: [ "ADPCM-3 bit (CCITT G.723)" - codec := ADPCMCodec new - initializeForBitsPerSample: 3 samplesPerFrame: 0. - totalSamples := (dataBytes // 3) * 8. - ^ self]. - format = 26 ifTrue: [ "ADPCM-5 bit (CCITT G.723)" - codec := ADPCMCodec new - initializeForBitsPerSample: 5 samplesPerFrame: 0. - totalSamples := (dataBytes // 5) * 8. - ^ self]. - format = 610 ifTrue: [ "GSM 06.10 (this format was added by Squeak)" - codec := GSMCodec new. - totalSamples := (dataBytes // 33) * 160. - ^ self]. - self error: 'unsupported Sun audio format ', format printString - ! Item was removed: - ----- Method: StreamingMonoSound>>repeat (in category 'accessing') ----- - repeat - "Answer the repeat flag." - - ^ repeat - ! Item was removed: - ----- Method: StreamingMonoSound>>repeat: (in category 'accessing') ----- - repeat: aBoolean - "Set the repeat flag. If true, this sound will loop back to the beginning when it gets to the end." - - repeat := aBoolean. - ! Item was removed: - ----- Method: StreamingMonoSound>>reset (in category 'playing') ----- - reset - - super reset. - self startOver. - self createMixer. - ! Item was removed: - ----- Method: StreamingMonoSound>>samplesRemaining (in category 'playing') ----- - samplesRemaining - "Answer the number of samples remaining to be played." - - | result | - (stream isNil or: [stream closed]) ifTrue: [^ 0]. - self repeat ifTrue: [^ 1000000]. - result := (totalSamples - self currentSampleIndex) max: 0. - result <= 0 ifTrue: [self closeFile]. - ^ result - ! Item was removed: - ----- Method: StreamingMonoSound>>saveAsFileNamed:compressionType: (in category 'converting') ----- - saveAsFileNamed: newFileName compressionType: compressionTypeString - "Store this sound in a new file with the given name using the given compression type. Useful for converting between compression formats." - - | outFile | - outFile := (FileStream newFileNamed: newFileName) binary. - self storeSunAudioOn: outFile compressionType: compressionTypeString. - outFile close. - ! Item was removed: - ----- Method: StreamingMonoSound>>soundPosition (in category 'accessing') ----- - soundPosition - "Answer the relative position of sound playback as a number between 0.0 and 1.0." - - (stream isNil or: [stream closed]) ifTrue: [^ 0.0]. - ^ self currentSampleIndex asFloat / totalSamples - ! Item was removed: - ----- Method: StreamingMonoSound>>soundPosition: (in category 'accessing') ----- - soundPosition: fraction - "Jump to the position the given fraction through the sound file. The argument is a number between 0.0 and 1.0." - - | desiredSampleIndex | - (stream isNil or: [stream closed]) ifTrue: [^ self]. - desiredSampleIndex := ((totalSamples * fraction) truncated max: 0) min: totalSamples. - codec - ifNil: [stream position: audioDataStart + (desiredSampleIndex * 2)] - ifNotNil: [self positionCodecTo: desiredSampleIndex]. - leftoverSamples := SoundBuffer new. - ! Item was removed: - ----- Method: StreamingMonoSound>>startOver (in category 'private') ----- - startOver - "Jump back to the first sample." - - stream reopen; binary. - self readHeader. - stream position: audioDataStart. - leftoverSamples := SoundBuffer new. - lastBufferMSecs := 0. - mutex := Semaphore forMutualExclusion. - ! Item was removed: - ----- Method: StreamingMonoSound>>storeSunAudioOn:compressionType: (in category 'converting') ----- - storeSunAudioOn: aBinaryStream compressionType: compressionName - "Store myself on the given stream as a monophonic sound compressed with the given type of compression. The sampling rate is reduced to 22050 samples/second if it is higher." - - | fmt inBufSize samplesPerFrame outCodec compressed outSamplingRate audioWriter | - self pause; reset. "stop playing and return to beginning" - - fmt := SunAudioFileWriter formatCodeForCompressionType: compressionName. - inBufSize := 64000. - samplesPerFrame := 1. - outCodec := SunAudioFileWriter codecForFormatCode: fmt. - outCodec ifNotNil: [ - samplesPerFrame := outCodec samplesPerFrame. - inBufSize := inBufSize roundUpTo: (2 * samplesPerFrame). - compressed := ByteArray new: - (inBufSize // samplesPerFrame) * outCodec bytesPerEncodedFrame]. - outSamplingRate := streamSamplingRate. - streamSamplingRate > 22050 ifTrue: [ - streamSamplingRate = 44100 ifFalse: [self error: 'unexpected MP3 sampling rate']. - outSamplingRate := 22050]. - - "write audio header" - audioWriter := SunAudioFileWriter onStream: aBinaryStream. - audioWriter writeHeaderSamplingRate: outSamplingRate format: fmt. - - "convert and write sound data" - 'Storing audio...' - displayProgressFrom: 0 to: totalSamples during: [:bar | | outBuf counts inBuf samplesRemaining byteCount | - samplesRemaining := totalSamples. - [samplesRemaining > 0] whileTrue: [ - bar value: totalSamples - samplesRemaining. - self loadBuffersForSampleCount: (inBufSize min: samplesRemaining). - inBuf := mixer sounds first samples. - outSamplingRate < streamSamplingRate - ifTrue: [outBuf := inBuf downSampledLowPassFiltering: true] - ifFalse: [outBuf := inBuf]. - outCodec - ifNil: [audioWriter appendSamples: outBuf] - ifNotNil: [ - counts := outCodec - encodeFrames: (outBuf size // samplesPerFrame) - from: outBuf at: 1 - into: compressed at: 1. - byteCount := counts last. - byteCount = compressed size - ifTrue: [audioWriter appendBytes: compressed] - ifFalse: [audioWriter appendBytes: (compressed copyFrom: 1 to: byteCount)]]. - samplesRemaining := samplesRemaining - inBuf monoSampleCount]]. - - "update audio header" - audioWriter updateHeaderDataSize. - ! Item was removed: - ----- Method: StreamingMonoSound>>streamSamplingRate (in category 'accessing') ----- - streamSamplingRate - "Answer the sampling rate of the MP3 stream." - - ^ streamSamplingRate - ! Item was removed: - ----- Method: StreamingMonoSound>>volume (in category 'accessing') ----- - volume - "Answer my volume." - - ^ volume - ! Item was removed: - ----- Method: StreamingMonoSound>>volume: (in category 'accessing') ----- - volume: aNumber - "Set my volume to the given number between 0.0 and 1.0." - - volume := aNumber. - self createMixer. - ! Item was removed: - ----- Method: String>>asSound (in category '*sound-synthesis') ----- - asSound - "Return a sound. Either from the sound library via SampleSound or - else the Beeper default" - ^ SampledSound - soundNamed: self - ifAbsent: [Beeper default]! Item was removed: - Object subclass: #SunAudioFileWriter - instanceVariableNames: 'stream headerStart' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !SunAudioFileWriter commentStamp: '<historical>' prior: 0! - I encode monophonic sampled sounds in Sun audio (.au) file format. Sun audio files have a very simple format but can store both compressed and uncompressed sample data. I can write this format either directly into a file or onto any writable binary stream. - ! Item was removed: - ----- Method: SunAudioFileWriter class>>codecForFormatCode: (in category 'sound storing') ----- - codecForFormatCode: formatCode - "Answer the codec for the given Sun audio file format number." - - formatCode = 1 ifTrue: [^ MuLawCodec new]. - formatCode = 3 ifTrue: [^ nil]. "uncompressed" - formatCode = 23 ifTrue: [^ ADPCMCodec newBitsPerSample: 4]. - formatCode = 25 ifTrue: [^ ADPCMCodec newBitsPerSample: 3]. - formatCode = 26 ifTrue: [^ ADPCMCodec newBitsPerSample: 5]. - formatCode = 610 ifTrue: [^ GSMCodec new]. - self error: 'unsupported Sun audio format' - ! Item was removed: - ----- Method: SunAudioFileWriter class>>formatCodeForCompressionType: (in category 'sound storing') ----- - formatCodeForCompressionType: aString - "Answer the Sun audio file format number for the given compression type name." - - | lowercase | - lowercase := aString asLowercase. - 'mulaw' = lowercase ifTrue: [^ 1]. - 'none' = lowercase ifTrue: [^ 3]. - 'adpcm3' = lowercase ifTrue: [^ 25]. - 'adpcm4' = lowercase ifTrue: [^ 23]. - 'adpcm5' = lowercase ifTrue: [^ 26]. - 'gsm' = lowercase ifTrue: [^ 610]. - self error: 'unknown compression style' - ! Item was removed: - ----- Method: SunAudioFileWriter class>>onFileNamed: (in category 'instance creation') ----- - onFileNamed: fileName - "Answer an instance of me on a newly created file with the given name." - - | file | - file := (FileStream newFileNamed: fileName) binary. - ^ self new setStream: file - ! Item was removed: - ----- Method: SunAudioFileWriter class>>onStream: (in category 'instance creation') ----- - onStream: aBinaryStream - "Answer an instance of me on the given binary stream." - - ^ self new setStream: aBinaryStream - ! Item was removed: - ----- Method: SunAudioFileWriter class>>storeSampledSound:onFileNamed:compressionType: (in category 'sound storing') ----- - storeSampledSound: aSampledSound onFileNamed: fileName compressionType: aString - "Store the samples of the given sampled sound on a file with the given name using the given type of compression. See formatCodeForCompressionType: for the list of compression types." - - | fmt codec f compressed | - fmt := self formatCodeForCompressionType: aString. - codec := self codecForFormatCode: fmt. - f := self onFileNamed: fileName. - f writeHeaderSamplingRate: aSampledSound originalSamplingRate format: fmt. - codec - ifNil: [f appendSamples: aSampledSound samples] - ifNotNil: [ - compressed := codec encodeSoundBuffer: aSampledSound samples. - f appendBytes: compressed]. - f closeFile. - ! Item was removed: - ----- Method: SunAudioFileWriter>>appendBytes: (in category 'other') ----- - appendBytes: aByteArray - "Append the given sample data to my stream." - - stream nextPutAll: aByteArray. - ! Item was removed: - ----- Method: SunAudioFileWriter>>appendSamples: (in category 'other') ----- - appendSamples: aSoundBuffer - "Append the given SoundBuffer to my stream." - - | swapBytes s | - (stream isKindOf: StandardFileStream) ifTrue: [ - "optimization: write sound buffer directly to file" - swapBytes := Smalltalk isLittleEndian. - swapBytes ifTrue: [aSoundBuffer reverseEndianness]. "make big endian" - stream next: (aSoundBuffer size // 2) putAll: aSoundBuffer startingAt: 1. "size in words" - swapBytes ifTrue: [aSoundBuffer reverseEndianness]. "revert to little endian" - ^ self]. - - "for non-file streams:" - s := WriteStream on: (ByteArray new: 2 * aSoundBuffer monoSampleCount). - 1 to: aSoundBuffer monoSampleCount do: [:i | s int16: (aSoundBuffer at: i)]. - self appendBytes: s contents. - ! Item was removed: - ----- Method: SunAudioFileWriter>>closeFile (in category 'other') ----- - closeFile - "Update the Sun audio file header to reflect the final size of the sound data. If my stream is a file stream, close it and, on a Macintosh, set the file type and creator to that used by SoundApp for Sun Audio files. (This does nothing on other platforms.)" - - self ensureOpen. - self updateHeaderDataSize. - (stream isKindOf: StandardFileStream) ifTrue: [ - stream close. - FileDirectory default setMacFileNamed: stream name type: 'ULAW' creator: 'SCPL']. - ! Item was removed: - ----- Method: SunAudioFileWriter>>ensureOpen (in category 'other') ----- - ensureOpen - "Ensure that my stream is open." - - stream closed ifTrue: [stream reopen; binary]. - ! Item was removed: - ----- Method: SunAudioFileWriter>>setStream: (in category 'initialization') ----- - setStream: aBinaryStream - "Initialize myself for writing on the given stream." - - stream := aBinaryStream. - headerStart := aBinaryStream position. - ! Item was removed: - ----- Method: SunAudioFileWriter>>updateHeaderDataSize (in category 'other') ----- - updateHeaderDataSize - "Update the Sun audio file header to reflect the final size of the sound data." - - | byteCount | - byteCount := stream position - (headerStart + 24). - stream position: headerStart + 8. - stream uint32: byteCount. - ! Item was removed: - ----- Method: SunAudioFileWriter>>writeHeaderSamplingRate: (in category 'other') ----- - writeHeaderSamplingRate: samplingRate - "Write a Sun audio file header for 16-bit linear format." - - self writeHeaderSamplingRate: samplingRate format: 3. - ! Item was removed: - ----- Method: SunAudioFileWriter>>writeHeaderSamplingRate:format: (in category 'other') ----- - writeHeaderSamplingRate: samplingRate format: audioFormat - "Write a Sun audio file header for the given sampling rate and format. Currently, only monophonic files are supported." - - self ensureOpen. - stream position: headerStart. - stream nextPutAll: '.snd' asByteArray. - stream uint32: 24. "header size in bytes" - stream uint32: 0. "sample data size in bytes; fill in later" - stream uint32: audioFormat. - stream uint32: samplingRate truncated. - stream uint32: 1. "channel count" - ! Item was removed: - AbstractScoreEvent subclass: #TempoEvent - instanceVariableNames: 'tempo' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !TempoEvent commentStamp: '<historical>' prior: 0! - Represents a tempo change in a MIDI score. - ! Item was removed: - ----- Method: TempoEvent class>>time:tempo: (in category 'instance creation') ----- - time: aTime tempo: aTempo - - ^ self new - time: aTime; - tempo: aTempo; - yourself! Item was removed: - ----- Method: TempoEvent>>isTempoEvent (in category 'classification') ----- - isTempoEvent - - ^ true - ! Item was removed: - ----- Method: TempoEvent>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPut: $(. - time printOn: aStream. - aStream nextPutAll: ': tempo '. - aStream nextPutAll: (120.0 * (500000.0 / tempo) printShowingMaxDecimalPlaces: 2). - aStream nextPut: $). - ! Item was removed: - ----- Method: TempoEvent>>tempo (in category 'accessing') ----- - tempo - - ^ tempo - ! Item was removed: - ----- Method: TempoEvent>>tempo: (in category 'accessing') ----- - tempo: anInteger - - tempo := anInteger. - ! Item was removed: - FMSound subclass: #UnloadedSound - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !UnloadedSound commentStamp: '<historical>' prior: 0! - Instances of me, which are really just FMSounds, are used placeholders for sounds that have been unloaded from this image but which may be re-loaded later. - ! Item was removed: - ----- Method: UnloadedSound class>>default (in category 'instruments') ----- - default - "UnloadedSound default play" - - | snd p | - snd := super new modulation: 1 ratio: 1. - p := OrderedCollection new. - p add: 0 at 0.0; add: 10 at 1.0; add: 100 at 1.0; add: 120 at 0.0. - snd addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3). - ^ snd setPitch: 440.0 dur: 1.0 loudness: 0.5 - ! Item was removed: - Envelope subclass: #VolumeEnvelope - instanceVariableNames: 'currentVol targetVol mSecsForChange' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! Item was removed: - ----- Method: VolumeEnvelope>>computeSlopeAtMSecs: (in category 'private') ----- - computeSlopeAtMSecs: mSecs - "Private!! Find the next inflection point of this envelope and compute its target volume and the number of milliseconds until the inflection point is reached." - - | t i | - ((loopEndMSecs ~~ nil) and: [mSecs >= loopEndMSecs]) ifTrue: [ "decay phase" - t := (points at: loopEndIndex) x + (mSecs - loopEndMSecs). - i := self indexOfPointAfterMSecs: t startingAt: loopEndIndex. - i == nil ifTrue: [ "past end" - targetVol := points last y * decayScale. - mSecsForChange := 0. - nextRecomputeTime := mSecs + 1000000. - ^ self]. - targetVol := (points at: i) y * decayScale. - mSecsForChange := (((points at: i) x - t) min: (endMSecs - mSecs)) max: 4. - nextRecomputeTime := mSecs + mSecsForChange. - ^ self]. - - mSecs < loopStartMSecs ifTrue: [ "attack phase" - i := self indexOfPointAfterMSecs: mSecs startingAt: 1. - targetVol := (points at: i) y. - mSecsForChange := ((points at: i) x - mSecs) max: 4. - nextRecomputeTime := mSecs + mSecsForChange. - ((loopEndMSecs ~~ nil) and: [nextRecomputeTime > loopEndMSecs]) - ifTrue: [nextRecomputeTime := loopEndMSecs]. - ^ self]. - - "sustain and loop phase" - noChangesDuringLoop ifTrue: [ - targetVol := (points at: loopEndIndex) y. - mSecsForChange := 10. - loopEndMSecs == nil - ifTrue: [nextRecomputeTime := mSecs + 10] "unknown end time" - ifFalse: [nextRecomputeTime := loopEndMSecs]. - ^ self]. - - loopMSecs = 0 ifTrue: [^ (points at: loopEndIndex) y]. "looping on a single point" - t := loopStartMSecs + ((mSecs - loopStartMSecs) \\ loopMSecs). - i := self indexOfPointAfterMSecs: t startingAt: loopStartIndex. - targetVol := (points at: i) y. - mSecsForChange := ((points at: i) x - t) max: 4. - nextRecomputeTime := (mSecs + mSecsForChange) min: loopEndMSecs. - ! Item was removed: - ----- Method: VolumeEnvelope>>reset (in category 'applying') ----- - reset - "Reset the state for this envelope." - - super reset. - target initialVolume: points first y * scale. - nextRecomputeTime := 0. - ! Item was removed: - ----- Method: VolumeEnvelope>>updateSelector (in category 'accessing') ----- - updateSelector - "Needed by the envelope editor." - - ^ #volume: - ! Item was removed: - ----- Method: VolumeEnvelope>>updateTargetAt: (in category 'applying') ----- - updateTargetAt: mSecs - "Update the volume envelope slope and limit for my target. Answer false." - - mSecs < nextRecomputeTime ifTrue: [^ false]. - self computeSlopeAtMSecs: mSecs. - mSecsForChange < 5 ifTrue: [mSecsForChange := 5]. "don't change instantly to avoid clicks" - target adjustVolumeTo: targetVol * scale overMSecs: mSecsForChange. - ^ false - ! Item was removed: - ----- Method: VolumeEnvelope>>volume: (in category 'accessing') ----- - volume: aNumber - "Set the maximum volume of a volume-controlling envelope." - - scale := aNumber asFloat. - ! Item was removed: - SoundCodec subclass: #WaveletCodec - instanceVariableNames: 'fwt samplesPerFrame nLevels alpha beta' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !WaveletCodec commentStamp: '<historical>' prior: 0! - The Wavelet codec performs a wavelet transform on the original data. It then achieves its compression by thresholding the transformed data, converting all values below a given magnitude to zero, and then run-coding the resulting data. The run-coding provides automatic variable compression depending on the parameters chosen. - - As is, this codec achieves reasonable reproduction at 10:1 compression, although the quality from the GSMCodec is definitely better. I feel that the quality would be comparable if uLaw scaling were introduced prior to thresholding. - - The nice thing about using wavelets is there are numerous factors to play with for better performance: - nLevels - the "order" of the transform performed - alpha and beta - these specify the wavelet shape (some are better for speech) - the actual threshold used - By simply changing these parameters, one can easily vary the compression achieved from 5:1 to 50:1, and listen to the quality at each step. - - The specific format for an encoded buffer is as follows: - 4 bytes: frameCount. - 4 bytes: samplesPerFrame. - 4 bytes: nLevels. - 4 bytes: alpha asIEEE32BitWord. - 4 bytes: beta asIEEE32BitWord. - frameCount occurrences of... - 2 bytes: frameSize in bytes, not including these 2 - may be = 0 for complete silence, meaning no scale even. - 4 bytes: scale asIEEE32BitWord. - A series of 1- or 2-byte values encoded as follows: - 0-111: a run of N+1 consecutive 0's; - 112-127: a run of (N-112)*256 + nextByte + 1 consecutive 0's; - 128-255: a 15-bit signed value = (N*256 + nextByte) - 32768 - 16384.! Item was removed: - ----- Method: WaveletCodec>>bytesPerEncodedFrame (in category 'subclass responsibilities') ----- - bytesPerEncodedFrame - "Answer the number of bytes required to hold one frame of compressed sound data. Answer zero if this codec produces encoded frames of variable size." - - ^ 0 - ! Item was removed: - ----- Method: WaveletCodec>>decodeFrames:from:at:into:at: (in category 'subclass responsibilities') ----- - 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." - - | frameBase coeffArray scale i c nullCount samples sourceFrameEnd frameSize inStream val | - inStream := ReadStream on: srcByteArray from: srcIndex to: srcByteArray size. - "frameCount := " inStream nextNumber: 4. - samplesPerFrame := inStream nextNumber: 4. - nLevels := inStream nextNumber: 4. - alpha := Float fromIEEE32Bit: (inStream nextNumber: 4). - beta := Float fromIEEE32Bit: (inStream nextNumber: 4). - fwt ifNil: - ["NOTE: This should read parameters from the encoded data" - fwt := FWT new. - fwt nSamples: samplesPerFrame nLevels: nLevels. - fwt setAlpha: alpha beta: beta]. - frameBase := dstIndex. - coeffArray := fwt coeffs. "A copy that we can modify" - - 1 to: frameCount do: - [:frame | - - "Decode the scale for this frame" - frameSize := inStream nextNumber: 2. - sourceFrameEnd := frameSize + inStream position. - scale := Float fromIEEE32Bit: (inStream nextNumber: 4). - - "Expand run-coded samples to scaled float values." - i := 5. - [i <= coeffArray size] - whileTrue: - [c := inStream next. - c < 128 - ifTrue: [nullCount := c < 112 - ifTrue: [c + 1] - ifFalse: [(c-112)*256 + inStream next + 1]. - i to: i + nullCount - 1 do: [:j | coeffArray at: j put: 0.0]. - i := i + nullCount] - ifFalse: [val := (c*256 + inStream next) - 32768 - 16384. - coeffArray at: i put: val * scale. - i := i + 1]]. - - "Copy float values into the wavelet sample array" - fwt coeffs: coeffArray. - - "Compute the transform" - fwt transformForward: false. - - "Determine the scale for this frame" - samples := fwt samples. - samples size = samplesPerFrame ifFalse: [self error: 'frame size error']. - 1 to: samples size do: - [:j | dstSoundBuffer at: frameBase + j - 1 put: (samples at: j) asInteger]. - - inStream position = sourceFrameEnd ifFalse: [self error: 'frame size error']. - frameBase := frameBase + samplesPerFrame]. - - ^ Array with: inStream position + 1 - srcIndex - with: frameBase - dstIndex! Item was removed: - ----- Method: WaveletCodec>>encodeFrames:from:at:into:at: (in category 'subclass responsibilities') ----- - 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." - - | frameBase coeffs maxVal minVal c scale nullCount frameI outFrameSize threshold "sm" outStream cMin val | - threshold := 2000. - fwt ifNil: - [samplesPerFrame := self samplesPerFrame. - nLevels := 8. - "Here are some sample mother wavelets, with the compression achieved on a - sample of my voice at a threshold of 2000: - compression achieved " - alpha := 0.0. beta := 0.0. "12.1" - alpha := 1.72. beta := 1.51. "14.0" - alpha := -1.86. beta := -1.53. "14.4" - alpha := 1.28. beta := -0.86. "15.9" - alpha := -1.15. beta := 0.69. "16.0" - fwt := FWT new. - fwt nSamples: samplesPerFrame nLevels: nLevels. - fwt setAlpha: alpha beta: beta]. - - (outStream := WriteStream on: dstByteArray from: dstIndex to: dstByteArray size) - nextNumber: 4 put: frameCount; - nextNumber: 4 put: samplesPerFrame; - nextNumber: 4 put: nLevels; - nextNumber: 4 put: alpha asIEEE32BitWord; - nextNumber: 4 put: beta asIEEE32BitWord. - frameBase := srcIndex. - 1 to: frameCount do: - [:frame | - - "Copy float values into the wavelet sample array" - fwt samples: ((frameBase to: frameBase + samplesPerFrame-1) - collect: [:i | (srcSoundBuffer at: i) asFloat]). - - "Compute the transform" - fwt transformForward: true. - - frameI := outStream position+1. "Reserve space for frame size" - outStream nextNumber: 2 put: 0. - - "Determine and output the scale for this frame" - coeffs := fwt coeffs. - maxVal := 0.0. minVal := 0.0. - 5 to: coeffs size do: - [:i | c := coeffs at: i. - c > maxVal ifTrue: [maxVal := c]. - c < minVal ifTrue: [minVal := c]]. - scale := (maxVal max: minVal negated) / 16000.0. "Will scale all to -16k..16k: 15 bits" - outStream nextNumber: 4 put: scale asIEEE32BitWord. - - "Copy scaled values, with run-coded sequences of 0's, to destByteArray" - nullCount := 0. - cMin := threshold / scale. - 5 to: coeffs size do: - [:i | c := (coeffs at: i) / scale. - c abs < cMin - ifTrue: ["Below threshold -- count nulls." - nullCount := nullCount + 1] - ifFalse: ["Above threshold -- emit prior null count and this sample." - nullCount > 0 ifTrue: - [nullCount <= 112 - ifTrue: [outStream nextNumber: 1 put: nullCount-1] - ifFalse: [outStream nextNumber: 2 put: (112*256) + nullCount-1]. - nullCount := 0]. - val := c asInteger + 16384 + 32768. "Map -16k..16k into 32k..64k" - outStream nextNumber: 2 put: val]]. - - nullCount > 0 ifTrue: - [nullCount <= 112 - ifTrue: [outStream nextNumber: 1 put: nullCount-1] - ifFalse: [outStream nextNumber: 2 put: (112*256) + nullCount-1]]. - outFrameSize := outStream position+1 - frameI - 2. "Write frame size back at the beginning" - (WriteStream on: dstByteArray from: frameI to: dstByteArray size) - nextNumber: 2 put: outFrameSize. - frameBase := frameBase + samplesPerFrame]. - - "fbs: disabled because it induces a Sound -> Morphic dependency. It might still be useful as a debugging aid." - "This displays a temporary indication of compression achieved" - "sm := TextMorph new contents: (((frameBase - srcIndex) *2.0 / (outStream position+1 - dstIndex) truncateTo: 0.1) printString , ' : 1') asText allBold. - sm position: Sensor cursorPoint + (-20 at 30). - ActiveWorld addMorph: sm. - World doOneCycleNow. - sm delete." - - outStream position > dstByteArray size ifTrue: - ["The calling routine only provides buffer space for compression of 2:1 or better. If you are just testing things, you can increase it to, eg, codeFrameSize := frameSize*3, which would be sufficient for a threshold of 0 (lossless conversion)." - self error: 'Buffer overrun']. - - ^ Array with: frameBase - srcIndex - with: outStream position+1 - dstIndex! Item was removed: - ----- Method: WaveletCodec>>frameCount: (in category 'subclass responsibilities') ----- - frameCount: aByteArray - "Compute the frame count for this byteArray. This default computation will have to be overridden by codecs with variable frame sizes." - - ^ (ReadStream on: aByteArray) nextNumber: 4. - ! Item was removed: - ----- Method: WaveletCodec>>samplesPerFrame (in category 'subclass responsibilities') ----- - samplesPerFrame - "Answer the number of sound samples per compression frame." - - ^ 4096 - !
More information about the Squeak-dev mailing list |