'From R&DSqueak2.8 of 6 June 2001 [latest update: #42] on 17 December 2001 at 8:42:22 am'! "Change Set: jpegMovieCreation-jm Date: 14 December 2001 Author: John Maloney Adds a menu button to MPEGMoviePlayerMorph. The 'Rate' and 'Repeat' buttons have become menu commands. Added menu commands for creating JPEG movies: a. from an MPEG movie b. from a SqueakTime movie c. from a folder full of image files Adds menu commands to remove or add a JPEG movie soundtrack with various compression options. Other improvements: a. better random access in ADPCM sound streams b. faster saving of AIFF files c. better movie audio/video sync d. handy methods for saving and converting audio files" ! AbstractSound subclass: #StreamingMP3Sound instanceVariableNames: 'volume repeat mpegFile mpegStreamIndex totalSamples streamSamplingRate mixer lastBufferMSecs mutex ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! AbstractSound subclass: #StreamingMonoSound instanceVariableNames: 'stream volume repeat headerStart audioDataStart streamSamplingRate totalSamples codec mixer leftoverSamples lastBufferMSecs mutex ' classVariableNames: '' poolDictionaries: '' category: 'Sound-Synthesis'! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 12/12/2001 17:57'! 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 ! ! !ADPCMCodec methodsFor: 'codec stuff' stamp: 'jm 12/14/2001 11:21'! reset self resetForMono. ! ! !ADPCMCodec methodsFor: 'private' stamp: 'jm 11/21/2001 11:35'! encodeLeft: leftSoundBuffer right: rightSoundBuffer bitsPerSample: bits frameSize: frameSize forFlash: flashFlag | stereoFlag sampleCount sampleBitCount bitCount | self initializeForBitsPerSample: bits samplesPerFrame: frameSize. stereoFlag _ rightSoundBuffer notNil. sampleCount _ leftSoundBuffer monoSampleCount. stereoFlag ifTrue: [sampleBitCount _ 2 * (sampleCount * bitsPerSample)] ifFalse: [sampleBitCount _ sampleCount * bitsPerSample]. bitCount _ sampleBitCount + (self headerBitsForSampleCount: sampleCount stereoFlag: stereoFlag). encodedBytes _ ByteArray new: ((bitCount / 8) ceiling roundUpTo: self bytesPerEncodedFrame). byteIndex _ 0. bitPosition _ 0. currentByte _ 0. flashFlag ifTrue: [self nextBits: 2 put: bits - 2]. stereoFlag ifTrue: [ samples _ Array with: leftSoundBuffer with: rightSoundBuffer. sampleIndex _ Array with: 0 with: 0. self privateEncodeStereo: sampleCount] ifFalse: [ samples _ leftSoundBuffer. sampleIndex _ 0. self privateEncodeMono: sampleCount]. ^ encodedBytes ! ! !JPEGMovieFile methodsFor: 'private' stamp: 'jm 12/13/2001 19:14'! soundtrackOffsets "Answer the offsets for my soundtracks." ^ soundtrackOffsets ! ! !JPEGMovieFile methodsFor: 'private' stamp: 'jm 11/27/2001 10:23'! testPlay "Performance benchmark. Decompress and display all my frames. Answer the frame rate achieved in frames/second. No sound is played." | frameForm frameCount t | frameForm _ Form extent: movieExtent depth: (Display depth max: 16). frameCount _ self videoFrames: 0. self videoSetFrame: 1 stream: 0. t _ [ frameCount timesRepeat: [ self videoReadFrameInto: frameForm stream: 0. frameForm display]. ] timeToRun. ^ ((1000.0 * frameCount) / t) roundTo: 0.01 ! ! !JPEGMovieFile class methodsFor: 'movie conversion' stamp: 'jm 12/13/2001 18:19'! convertFromFolderOfFramesNamed: folderName toJPEGMovieNamed: jpegFileName frameRate: frameRate quality: quality "Convert a folder of frames into a JPEG movie. The named folder is assumed to contain only image files, all of the same size, and whose alphabetical order (case-insensitive) is the sequence in which they will appear in in the movie. A useful convention is to make the image files end in zero-padded frame numbers, for example 'frame0001.bmp', 'frame0002.bmp', etc. The image files can be any format readable by Form>fromFileNamed:. The movie frame extent is taken from the first frame file." | jpegFile dir fileNames frameCount frameForm frameOffsets | (FileDirectory default directoryExists: folderName) ifFalse: [^ self inform: 'Folder not found: ', folderName]. jpegFile _ (FileStream newFileNamed: jpegFileName) binary. dir _ FileDirectory default on: folderName. fileNames _ dir fileNames sort: [:n1 :n2 | n1 caseInsensitiveLessOrEqual: n2]. frameCount _ fileNames size. frameForm _ Form fromFileNamed: (dir fullNameFor: fileNames first). "write header" self writeHeaderExtent: frameForm extent frameRate: frameRate frameCount: frameCount soundtrackCount: 0 on: jpegFile. "convert and write frames" frameOffsets _ Array new: frameCount + 1. 1 to: frameCount do: [:i | frameOffsets at: i put: jpegFile position. frameForm _ Form fromFileNamed: (dir fullNameFor: (fileNames at: i)). self writeFrame: frameForm on: jpegFile quality: quality displayFlag: true]. frameOffsets at: (frameCount + 1) put: jpegFile position. self updateFrameOffsets: frameOffsets on: jpegFile. jpegFile close. Display restore. ! ! !JPEGMovieFile class methodsFor: 'movie conversion' stamp: 'jm 12/13/2001 09:38'! convertMPEGFileNamed: mpegFileName toJPEGMovieNamed: jpegFileName quality: quality "Convert the MPEG movie with the given file name into a JPEG movie with the given file name." | mpegFile jpegFile soundtrackCount movieExtent frameOffsets soundTrackOffsets | (FileDirectory default fileExists: mpegFileName) ifFalse: [^ self inform: 'File not found: ', mpegFileName]. (MPEGFile isFileValidMPEG: mpegFileName) ifFalse: [^ self inform: 'Not an MPEG file: ', mpegFileName]. mpegFile _ MPEGFile openFile: mpegFileName. mpegFile fileHandle ifNil: [^ self inform: 'Could not open ', mpegFileName]. jpegFile _ (FileStream newFileNamed: jpegFileName) binary. "write header" soundtrackCount _ mpegFile hasAudio ifTrue: [1] ifFalse: [0]. mpegFile hasVideo ifTrue: [ movieExtent _ (mpegFile videoFrameWidth: 0)@(mpegFile videoFrameHeight: 0). self writeHeaderExtent: movieExtent frameRate: (mpegFile videoFrameRate: 0) frameCount: (mpegFile videoFrames: 0) soundtrackCount: soundtrackCount on: jpegFile] ifFalse: [ self writeHeaderExtent: 0@0 frameRate: 0 frameCount: 0 soundtrackCount: soundtrackCount on: jpegFile]. "convert and write frames" frameOffsets _ self writeFramesFrom: mpegFile on: jpegFile quality: quality. self updateFrameOffsets: frameOffsets on: jpegFile. "convert and write sound tracks" jpegFile position: frameOffsets last. "store sound tracks after the last frame" soundTrackOffsets _ self writeSoundTracksFrom: mpegFile on: jpegFile. self updateSoundtrackOffsets: soundTrackOffsets frameOffsets: frameOffsets on: jpegFile. mpegFile closeFile. jpegFile close. Display restore. ! ! !JPEGMovieFile class methodsFor: 'movie conversion' stamp: 'jm 12/13/2001 09:39'! convertSqueakMovieNamed: squeakMovieFileName toJPEGMovieNamed: jpegFileName quality: quality "Convert the Squeak movie with the given file name into a JPEG movie with the given file name." | sqMovieFile jpegFile w h d frameCount mSecsPerFrame frameForm bytesPerFrame frameOffsets | (FileDirectory default fileExists: squeakMovieFileName) ifFalse: [^ self inform: 'File not found: ', squeakMovieFileName]. sqMovieFile _ (FileStream readOnlyFileNamed: squeakMovieFileName) binary. sqMovieFile ifNil: [^ self inform: 'Could not open ', squeakMovieFileName]. jpegFile _ (FileStream newFileNamed: jpegFileName) binary. sqMovieFile nextInt32. "skip first word" w _ sqMovieFile nextInt32. h _ sqMovieFile nextInt32. d _ sqMovieFile nextInt32. frameCount _ sqMovieFile nextInt32. mSecsPerFrame _ (sqMovieFile nextInt32) / 1000.0. "write header" self writeHeaderExtent: w@h frameRate: (1000.0 / mSecsPerFrame) frameCount: frameCount soundtrackCount: 0 on: jpegFile. "convert and write frames" frameForm _ Form extent: w@h depth: d. bytesPerFrame _ 4 + (frameForm bits size * 4). frameOffsets _ Array new: frameCount + 1. 1 to: frameCount do: [:i | frameOffsets at: i put: jpegFile position. sqMovieFile position: 128 + ((i - 1) * bytesPerFrame) + 4. sqMovieFile next: frameForm bits size into: frameForm bits startingAt: 1. frameForm display. self writeFrame: frameForm on: jpegFile quality: quality displayFlag: false]. frameOffsets at: (frameCount + 1) put: jpegFile position. self updateFrameOffsets: frameOffsets on: jpegFile. sqMovieFile close. jpegFile close. Display restore. ! ! !JPEGMovieFile class methodsFor: 'movie soundtracks' stamp: 'jm 12/13/2001 21:03'! addSoundtrack: soundFileName toJPEGMovieNamed: jpegFileName compressionType: compressionTypeString "Append the given audio file as a soundtrack the given JPEG movie using the given compression type ('none', 'adpcm3', 'adpcm4', 'adpcm5', 'mulaw', or 'gsm')." "Note: While the Squeak JPEG movie format supports multiple soundtracks, the player currently plays only the first soundtrack." | snd jpegFile outFile frameCount newFrameOffsets buf inFile newSoundtrackOffsets oldMovieName | snd _ StreamingMonoSound onFileNamed: soundFileName. jpegFile _ JPEGMovieFile new openFileNamed: jpegFileName. outFile _ (FileStream newFileNamed: 'movie.tmp') binary. frameCount _ jpegFile videoFrames: 0. "write new header" self writeHeaderExtent: ((jpegFile videoFrameWidth: 0)@(jpegFile videoFrameHeight: 0)) frameRate: (jpegFile videoFrameRate: 0) frameCount: frameCount soundtrackCount: (jpegFile soundtrackOffsets size + 1) on: outFile. "copy frames to new file" newFrameOffsets _ Array new: frameCount + 1. 1 to: frameCount do: [:i | newFrameOffsets at: i put: outFile position. buf _ jpegFile bytesForFrame: i. outFile nextPutAll: buf]. newFrameOffsets at: frameCount + 1 put: outFile position. "copy existing soundtracks, if any, to new file" jpegFile soundtrackOffsets size > 0 ifTrue: [ inFile _ jpegFile fileHandle. inFile position: jpegFile soundtrackOffsets first. buf _ ByteArray new: 10000. [inFile atEnd] whileFalse: [ buf _ inFile next: buf size into: buf startingAt: 1. outFile nextPutAll: buf]]. "adjust soundtrack offsets for header size increase and add new one:" newSoundtrackOffsets _ jpegFile soundtrackOffsets collect: [:n | n + 4]. newSoundtrackOffsets _ newSoundtrackOffsets copyWith: outFile position. snd storeSunAudioOn: outFile compressionType: compressionTypeString. "update header:" self updateFrameOffsets: newFrameOffsets on: outFile. self updateSoundtrackOffsets: newSoundtrackOffsets frameOffsets: newFrameOffsets on: outFile. "close files" snd closeFile. jpegFile closeFile. outFile close. "replace the old movie with the new version" oldMovieName _ (jpegFile fileName copyFrom: 1 to: (jpegFile fileName size - 4)), '.old'. FileDirectory default deleteFileNamed: oldMovieName. FileDirectory default rename: jpegFile fileName toBe: oldMovieName. FileDirectory default rename: 'movie.tmp' toBe: jpegFile fileName. ! ! !JPEGMovieFile class methodsFor: 'movie soundtracks' stamp: 'jm 12/13/2001 21:03'! removeSoundtrackFromJPEGMovieNamed: jpegFileName "Remove all soundtracks from the JPEG movie with the given name." | jpegFile outFile frameCount newFrameOffsets buf oldMovieName | jpegFile _ JPEGMovieFile new openFileNamed: jpegFileName. outFile _ (FileStream newFileNamed: 'movie.tmp') binary. frameCount _ jpegFile videoFrames: 0. "write new header" self writeHeaderExtent: ((jpegFile videoFrameWidth: 0)@(jpegFile videoFrameHeight: 0)) frameRate: (jpegFile videoFrameRate: 0) frameCount: frameCount soundtrackCount: 0 on: outFile. "copy frames to new file" newFrameOffsets _ Array new: frameCount + 1. 1 to: frameCount do: [:i | newFrameOffsets at: i put: outFile position. buf _ jpegFile bytesForFrame: i. outFile nextPutAll: buf]. newFrameOffsets at: frameCount + 1 put: outFile position. "update header:" self updateFrameOffsets: newFrameOffsets on: outFile. "close files" jpegFile closeFile. outFile close. "replace the old movie with the new version" oldMovieName _ (jpegFile fileName copyFrom: 1 to: (jpegFile fileName size - 4)), '.old'. FileDirectory default deleteFileNamed: oldMovieName. FileDirectory default rename: jpegFile fileName toBe: oldMovieName. FileDirectory default rename: 'movie.tmp' toBe: jpegFile fileName. ! ! !MPEGDisplayMorph methodsFor: 'accessing' stamp: 'jm 12/16/2001 12:34'! moviePosition: fraction "Jump to the position the given fraction through the movie. The argument is a number between 0.0 and 1.0." | frameCount frameIndex | self mpegFileIsOpen ifFalse: [^ self]. self stopPlaying. mpegFile hasVideo ifTrue: [ frameCount _ mpegFile videoFrames: 0. frameIndex _ (frameCount * fraction) truncated - 1. frameIndex _ (frameIndex max: 0) min: (frameCount - 3). mpegFile videoSetFrame: frameIndex stream: 0. ^ self nextFrame]. mpegFile hasAudio ifTrue: [ soundTrack soundPosition: fraction]. ! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'jm 12/14/2001 15:34'! addSoundtrack "Add a soundtrack to this JPEG movie." | result soundFileName menu compression | (mpegFile isKindOf: JPEGMovieFile) ifFalse: [^ self]. "do nothing if not a JPEG movie" result _ StandardFileMenu oldFile. result ifNil: [^ self]. soundFileName _ result directory pathName, FileDirectory slash, result name. menu _ CustomMenu new title: 'Compression type:'. menu addList: #( ('none (353 kbps)' none) ('mulaw (176 kbps)' mulaw) ('adpcm5 (110 kbps)' adpcm5) ('adpcm4 (88 kbps)' adpcm4) ('adpcm3 (66 kbps)' adpcm3) ('gsm (36 kbps)' gsm)). compression _ menu startUp. compression ifNil: [^ self]. mpegFile closeFile. JPEGMovieFile addSoundtrack: soundFileName toJPEGMovieNamed: mpegFile fileName compressionType: compression. self openFileNamed: mpegFile fileName. ! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'jm 12/17/2001 08:15'! createJPEGfromFolderOfFrames "Create a new JPEG movie file from an folder of individual frames. Prompt the user for the folder and file names and the quality setting, then do the conversion." | result folderName jpegFileName q frameRate | result _ StandardFileMenu oldFile. result ifNil: [^ self]. folderName _ result directory pathName. jpegFileName _ FillInTheBlank request: 'New movie name?'. jpegFileName size = 0 ifTrue: [^ self]. (jpegFileName asLowercase endsWith: '.jmv') ifFalse: [ jpegFileName _ jpegFileName, '.jmv']. result _ FillInTheBlank request: 'Quality level (1 to 100)?'. q _ result ifNil: [50] ifNotNil: [(result asNumber rounded max: 1) min: 100]. result _ FillInTheBlank request: 'Frame rate?'. frameRate _ result ifNil: [10] ifNotNil: [(result asNumber rounded max: 1) min: 100]. JPEGMovieFile convertFromFolderOfFramesNamed: folderName toJPEGMovieNamed: jpegFileName frameRate: frameRate quality: q. ! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'jm 12/17/2001 08:15'! createJPEGfromMPEG "Create a new JPEG movie file from an MPEG movie. Prompt the user for the file names and the quality setting, then do the conversion." | result mpegFileName jpegFileName q | result _ StandardFileMenu oldFile. result ifNil: [^ self]. mpegFileName _ result directory pathName, FileDirectory slash, result name. jpegFileName _ FillInTheBlank request: 'New movie name?'. jpegFileName size = 0 ifTrue: [^ self]. (jpegFileName asLowercase endsWith: '.jmv') ifFalse: [ jpegFileName _ jpegFileName, '.jmv']. result _ FillInTheBlank request: 'Quality level (1 to 100)?'. q _ result ifNil: [50] ifNotNil: [(result asNumber rounded max: 1) min: 100]. JPEGMovieFile convertMPEGFileNamed: mpegFileName toJPEGMovieNamed: jpegFileName quality: q. ! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'jm 12/17/2001 08:15'! createJPEGfromSqueakMovie "Create a new JPEG movie file from an SqueakTime movie. Prompt the user for the file names and the quality setting, then do the conversion." | result squeakMovieFileName jpegFileName q | result _ StandardFileMenu oldFile. result ifNil: [^ self]. squeakMovieFileName _ result directory pathName, FileDirectory slash, result name. jpegFileName _ FillInTheBlank request: 'New movie name?'. jpegFileName size = 0 ifTrue: [^ self]. (jpegFileName asLowercase endsWith: '.jmv') ifFalse: [ jpegFileName _ jpegFileName, '.jmv']. result _ FillInTheBlank request: 'Quality level (1 to 100)?'. q _ result ifNil: [50] ifNotNil: [(result asNumber rounded max: 1) min: 100]. JPEGMovieFile convertSqueakMovieNamed: squeakMovieFileName toJPEGMovieNamed: jpegFileName quality: q. ! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'jm 12/13/2001 20:46'! invokeMenu "Invoke a menu of additonal functions." | aMenu | aMenu _ CustomMenu new. repeat ifTrue: [aMenu add: 'turn off repeat (now on)' action: #toggleRepeat] ifFalse: [aMenu add: 'turn on repeat (now off)' action: #toggleRepeat]. aMenu addList: #( - ('set frame rate' setFrameRate) - ('create JPEG movie from MPEG' createJPEGfromMPEG) ('create JPEG movie from SqueakMovie' createJPEGfromSqueakMovie) ('create JPEG movie from folder of frames' createJPEGfromFolderOfFrames) - ). (mpegFile isKindOf: JPEGMovieFile) ifTrue: [ mpegFile hasAudio ifTrue: [aMenu add: 'remove all soundtracks' action: #removeAllSoundtracks] ifFalse: [aMenu add: 'add soundtrack' action: #addSoundtrack]]. aMenu invokeOn: self defaultSelection: nil. ! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'jm 12/13/2001 20:48'! removeAllSoundtracks "Remove all soundtracks from this JPEG movie." (mpegFile isKindOf: JPEGMovieFile) ifFalse: [^ self]. "do nothing if not a JPEG movie" mpegFile closeFile. JPEGMovieFile removeSoundtrackFromJPEGMovieNamed: mpegFile fileName. self openFileNamed: mpegFile fileName. ! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'jm 12/13/2001 08:55'! toggleRepeat "Toggle the repeat flag." repeat _ repeat not. ! ! !MPEGDisplayMorph methodsFor: 'other' stamp: 'jm 12/14/2001 15:11'! advanceFrame "Advance to the next frame if it is time to do so, skipping frames if necessary." | msecs currentFrame desiredFrame framesToAdvance | mpegFile hasVideo ifFalse: [^ self]. soundTrack ifNil: [msecs _ Time millisecondClockValue - startMSecs] ifNotNil: [msecs _ soundTrack millisecondsSinceStart - SoundPlayer bufferMSecs]. desiredFrame _ startFrame + ((msecs * desiredFrameRate) // 1000) + 1. desiredFrame _ desiredFrame min: (mpegFile videoFrames: 0). currentFrame _ mpegFile videoGetFrame: 0. framesToAdvance _ desiredFrame - currentFrame. framesToAdvance <= 0 ifTrue: [^ self]. (allowFrameDropping and: [framesToAdvance > 1]) ifTrue: [ mpegFile videoDropFrames: framesToAdvance - 1 stream: 0]. self nextFrame. ! ! !MPEGMoviePlayerMorph methodsFor: 'menu' stamp: 'jm 12/13/2001 08:43'! invokeMenu "Invoke a menu of additonal functions." | aMenu | aMenu _ CustomMenu new. aMenu addList: #( ('set frame rate' setFrameRate) ('convert MPEG to JPEG movie' showFFTAtCursor)). aMenu invokeOn: moviePlayer defaultSelection: nil. ! ! !MPEGMoviePlayerMorph methodsFor: 'private' stamp: 'jm 12/13/2001 08:59'! addButtonRow | r | r _ AlignmentMorph newRow vResizing: #shrinkWrap; color: Color transparent. r addMorphBack: (self buttonName: 'Open' action: #openMPEGFile). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Menu' action: #invokeMenu). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Rewind' action: #rewindMovie). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Play' action: #startPlaying). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Stop' action: #stopPlaying). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: '<' action: #previousFrame). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: '>' action: #nextFrame). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). self addMorphBack: r. ! ! !StreamingMP3Sound methodsFor: 'initialization' stamp: 'jm 11/27/2001 10:06'! initMPEGFile: anMPEGFile streamIndex: anInteger "Initialize for playing the given stream of the given MPEG or MP3 file." volume _ 0.3. repeat _ false. mpegFile _ anMPEGFile. mpegStreamIndex _ anInteger. totalSamples _ mpegFile audioSamples: mpegStreamIndex. self reset. ! ! !StreamingMP3Sound methodsFor: 'playing' stamp: 'jm 11/27/2001 10:16'! millisecondsSinceStart "Answer the number of milliseconds since this sound started playing." | i mSecs | mpegFile ifNil: [^ 0]. mpegFile fileHandle ifNil: [^ 0]. "mpeg file not open" i _ mpegFile audioGetSample: mpegStreamIndex. i < 0 ifTrue: [^ 0]. "movie file has no audio" mSecs _ i * 1000 // streamSamplingRate. (self isPlaying and: [lastBufferMSecs > 0]) ifTrue: [ "adjust mSecs by the milliseconds since the last buffer" mutex critical: [ mSecs _ i * 1000 // streamSamplingRate. mSecs _ mSecs + ((Time millisecondClockValue - lastBufferMSecs) max: 0)]]. ^ mSecs + 350 - (2 * SoundPlayer bufferMSecs) ! ! !StreamingMP3Sound methodsFor: 'playing' stamp: 'jm 11/27/2001 10:09'! playSampleCount: n into: aSoundBuffer startingAt: startIndex "Mix the next n samples of this sound into the given buffer starting at the given index" | current | self repeat ifTrue: [ "loop if necessary" current _ mpegFile audioGetSample: mpegStreamIndex. (totalSamples - current) < n ifTrue: [ mpegFile audioSetSample: 0 stream: mpegStreamIndex]]. mutex critical: [ lastBufferMSecs _ Time millisecondClockValue. self loadBuffersForSampleCount: (n * streamSamplingRate) // SoundPlayer samplingRate. mixer playSampleCount: n into: aSoundBuffer startingAt: startIndex]. ! ! !StreamingMP3Sound methodsFor: 'playing' stamp: 'jm 11/27/2001 10:06'! reset super reset. self createMixer. mpegFile audioSetSample: 0 stream: mpegStreamIndex. lastBufferMSecs _ 0. mutex _ Semaphore forMutualExclusion. ! ! !StreamingMP3Sound methodsFor: 'converting' stamp: 'jm 12/13/2001 20:32'! saveAsFileNamed: newFileName compressionType: compressionTypeString "Store this MP3 sound in a SunAudio file with the given name using the given compression type." | outFile | outFile _ (FileStream newFileNamed: newFileName) binary. self storeSunAudioOn: outFile compressionType: compressionTypeString. outFile close. ! ! !StreamingMP3Sound methodsFor: 'converting' stamp: 'jm 12/14/2001 12:39'! storeSunAudioOn: aBinaryStream compressionType: compressionName "Store myself on the given stream as a monophonic sound compressed with the given type of compression. The sampling rate is reduced to 22050 samples/second if it is higher." | fmt inBufSize samplesPerFrame codec inBuf compressed outSamplingRate audioWriter samplesRemaining outBuf counts byteCount | self pause; reset. "stop playing and return to beginning" fmt _ SunAudioFileWriter formatCodeForCompressionType: compressionName. inBufSize _ 64000. samplesPerFrame _ 1. codec _ SunAudioFileWriter codecForFormatCode: fmt. codec ifNotNil: [ samplesPerFrame _ codec samplesPerFrame. inBufSize _ inBufSize roundUpTo: (2 * samplesPerFrame). compressed _ ByteArray new: (inBufSize // samplesPerFrame) * codec bytesPerEncodedFrame]. inBuf _ SoundBuffer newMonoSampleCount: inBufSize. outSamplingRate _ streamSamplingRate. streamSamplingRate > 22050 ifTrue: [ streamSamplingRate = 44100 ifFalse: [self error: 'unexpected MP3 sampling rate']. outSamplingRate _ 22050]. "write audio header" audioWriter _ SunAudioFileWriter onStream: aBinaryStream. audioWriter writeHeaderSamplingRate: outSamplingRate format: fmt. "convert and write sound data" 'Storing audio...' displayProgressAt: Sensor cursorPoint from: 0 to: totalSamples during: [:bar | samplesRemaining _ totalSamples. [samplesRemaining > 0] whileTrue: [ bar value: totalSamples - samplesRemaining. samplesRemaining < inBuf monoSampleCount ifTrue: [ inBuf _ SoundBuffer newMonoSampleCount: (samplesRemaining roundUpTo: 2 * samplesPerFrame)]. mpegFile audioReadBuffer: inBuf stream: 0 channel: 0. outSamplingRate < streamSamplingRate ifTrue: [outBuf _ inBuf downSampledLowPassFiltering: true] ifFalse: [outBuf _ inBuf]. codec ifNil: [audioWriter appendSamples: outBuf] ifNotNil: [ counts _ codec encodeFrames: (outBuf size // samplesPerFrame) from: outBuf at: 1 into: compressed at: 1. byteCount _ counts last. byteCount = compressed size ifTrue: [audioWriter appendBytes: compressed] ifFalse: [audioWriter appendBytes: (compressed copyFrom: 1 to: byteCount)]]. samplesRemaining _ samplesRemaining - inBuf monoSampleCount]]. "update audio header" audioWriter updateHeaderDataSize. ! ! !StreamingMonoSound methodsFor: 'accessing' stamp: 'jm 12/14/2001 11:29'! 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. ! ! !StreamingMonoSound methodsFor: 'playing' stamp: 'jm 11/27/2001 09:19'! 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) ! ! !StreamingMonoSound methodsFor: 'playing' stamp: 'jm 11/27/2001 07:58'! 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]. ! ! !StreamingMonoSound methodsFor: 'other' stamp: 'jm 12/14/2001 11:01'! closeFile "Close my stream, if it responds to close." stream ifNotNil: [ (stream respondsTo: #close) ifTrue: [stream close]]. mixer _ nil. codec _ nil. ! ! !StreamingMonoSound methodsFor: 'converting' stamp: 'jm 12/13/2001 20:08'! 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. ! ! !StreamingMonoSound methodsFor: 'converting' stamp: 'jm 12/14/2001 10:10'! 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 samplesRemaining inBuf outBuf counts byteCount | 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...' displayProgressAt: Sensor cursorPoint from: 0 to: totalSamples during: [:bar | 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. ! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 12/14/2001 14:57'! 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].! ! !StreamingMonoSound methodsFor: 'private' stamp: 'jm 11/27/2001 07:36'! startOver "Jump back to the first sample." stream reopen; binary. self readHeader. stream position: audioDataStart. leftoverSamples _ SoundBuffer new. lastBufferMSecs _ 0. mutex _ Semaphore forMutualExclusion. ! ! !AIFFFileReader methodsFor: '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. ! ! !MPEGPlayer methodsFor: 'video' stamp: 'jm 12/17/2001 09:36'! videoLoop: aStream | location oneTime | oneTime _ true. [self external videoReadFrameInto: self form stream: aStream. oneTime ifTrue: [oneTime _ false. self noSound ifFalse: [self playAudioStreamNoSeek: aStream. semaphoreForSound wait. (Delay forMilliseconds: errorForSoundStart) wait]. self startTimeForStream: aStream put: (Time millisecondClockValue)]. self morph ifNil: [self form == Display ifTrue: [Display forceToScreen] ifFalse: [self form displayOn: Display]]. self changed. location _ (self currentVideoFrameForStream: aStream)+1. true ifTrue: [self calculateDelayGivenFrame: location stream: aStream] ifFalse: [self calculateDelayToSoundGivenFrame: location stream: aStream]. (self endOfVideo: aStream) ifTrue: [^self]] repeat.! ! !MPEGPlayer2 methodsFor: 'video' stamp: 'jm 12/17/2001 09:37'! getVideoPicture | morphsForm | self mpegFile ifNil: [^nil]. self mpegFile hasVideo ifFalse: [^self]. morphsForm _ videoMorph rotatedForm. myMpegFile videoReadFrameInto: morphsForm stream: 0. videoMorph changed. ! ! !MPEGPlayer2 methodsFor: 'video' stamp: 'jm 12/17/2001 09:38'! playVideo: aStream | morphsForm | morphsForm _ self videoMorph rotatedForm. startTime _ Time millisecondClockValue. startFrame _ myMpegFile videoGetFrame: aStream. videoPlayerProcess _ [ [ (myMpegFile videoGetFrame: 0) <= (myMpegFile videoFrames: 0) ] whileTrue: [ self timing. myMpegFile videoReadFrameInto: morphsForm stream: aStream. morphsForm displayAt: videoMorph topLeft. ]. videoPlayerProcess _ nil ] forkAt: Processor userSchedulingPriority. ! ! SampledSound class removeSelector: #fromAIFFStream:! LoopedSampledSound class removeSelector: #fromAIFFStream:! LoopedSampledSound class removeSelector: #fromAIFFStream:mergeIfStereo:! AIFFFileReader removeSelector: #readFrom:mergeIfStereo:skipDataChunk:! !JPEGMovieFile class reorganize! ('testing' isJPEGMovieFile:) ('movie conversion' convertFromFolderOfFramesNamed:toJPEGMovieNamed:frameRate:quality: convertMPEGFileNamed:toJPEGMovieNamed:quality: convertSqueakMovieNamed:toJPEGMovieNamed:quality:) ('movie soundtracks' addSoundtrack:toJPEGMovieNamed:compressionType: removeSoundtrackFromJPEGMovieNamed:) ('movie creation-private' updateFrameOffsets:on: updateSoundtrackOffsets:frameOffsets:on: writeFrame:on:quality:displayFlag: writeFramesFrom:on:quality: writeHeaderExtent:frameRate:frameCount:soundtrackCount:on: writeSoundTracksFrom:on:) ! !ADPCMCodec reorganize! ('bit streaming' nextBits: nextBits:put:) ('codec stuff' bytesPerEncodedFrame compressAndDecompress: decodeFrames:from:at:into:at: encodeFrames:from:at:into:at: reset resetForMono resetForStereo samplesPerFrame) ('private' decode:bitsPerSample: decode:sampleCount:bitsPerSample:frameSize:stereo: decodeFlash:sampleCount:stereo: encode:bitsPerSample: encodeFlashLeft:right:bitsPerSample: encodeLeft:right:bitsPerSample:frameSize:forFlash: headerBitsForSampleCount:stereoFlag: indexForDeltaFrom:to: initializeForBitsPerSample:samplesPerFrame: privateDecodeMono: privateDecodeStereo: privateEncodeMono: privateEncodeStereo:) !