Tim Felgentreff uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-tfel.358.mcz
==================== Summary ====================
Name: Graphics-tfel.358 Author: tfel Time: 8 August 2016, 8:58:52.805735 am UUID: f2b076dd-eefc-844f-9899-a17dc878b0df Ancestors: Graphics-tfel.357, Graphics-mt.357
merge trunk
=============== Diff against Graphics-mt.357 ===============
Item was changed: ----- Method: Form class>>importImage: (in category 'fileIn/Out') ----- importImage: fullName "Import the given image file and store the resulting Form in the default Imports. + The image is named with the short filename up to the first period, possibly with additions from the directory path to make it unique. Does nothing if called with nil fullName." - The image is named with the short filename up to the first period, possibly with additions from the directory path to make it unique."
+ fullName ifNotNil: + [Imports default importImageFromFileNamed: fullName] - Imports default importImageFromFileNamed: fullName. !
Item was changed: ----- Method: Form class>>openAsBackground: (in category 'file list services') ----- openAsBackground: fullName "Set an image as a background image. Support Squeak's common file format + (GIF, JPG, PNG, 'Form stoteOn: (run coded)' and BMP). + If name provided is nil, does nothing." - (GIF, JPG, PNG, 'Form stoteOn: (run coded)' and BMP)"
+ fullName ifNotNil: + [(self fromFileNamed: fullName) setAsBackground]! - (self fromFileNamed: fullName) setAsBackground!
Item was changed: ----- Method: Form class>>serviceImageAsBackground (in category 'file list services') ----- serviceImageAsBackground "Answer a service for setting the desktop background from a given graphical file's contents"
^ SimpleServiceEntry provider: self + label: 'use graphic as background' translatedNoop - label: 'use graphic as background' selector: #openAsBackground: + description: 'use the graphic as the background for the desktop' translatedNoop + buttonLabel: 'background' translatedNoop! - description: 'use the graphic as the background for the desktop' - buttonLabel: 'background'!
Item was changed: ----- Method: Form class>>serviceImageImportDirectory (in category 'file list services') ----- serviceImageImportDirectory "Answer a service for reading a graphic into ImageImports"
^(SimpleServiceEntry provider: self + label: 'import all images from this directory' translatedNoop - label: 'import all images from this directory' selector: #importImageDirectory: + description: 'Load all graphics found in this directory, adding them to the ImageImports repository.' translatedNoop + buttonLabel: 'import dir' translatedNoop) - description: 'Load all graphics found in this directory, adding them to the ImageImports repository.' - buttonLabel: 'import dir') argumentGetter: [ :fileList | fileList directory ]; yourself !
Item was changed: ----- Method: Form class>>serviceImageImportDirectoryWithSubdirectories (in category 'file list services') ----- serviceImageImportDirectoryWithSubdirectories "Answer a service for reading all graphics from a directory and its subdirectories into ImageImports"
^(SimpleServiceEntry provider: self + label: 'import all images from here and subdirectories' translatedNoop - label: 'import all images from here and subdirectories' selector: #importImageDirectoryWithSubdirectories: + description: 'Load all graphics found in this directory and its subdirectories, adding them to the ImageImports repository.' translatedNoop + buttonLabel: 'import subdirs' translatedNoop) - description: 'Load all graphics found in this directory and its subdirectories, adding them to the ImageImports repository.' - buttonLabel: 'import subdirs') argumentGetter: [ :fileList | fileList directory ]; yourself !
Item was changed: ----- Method: Form class>>serviceOpenImageInWindow (in category 'file list services') ----- serviceOpenImageInWindow "Answer a service for opening a graphic in a window"
^ SimpleServiceEntry provider: self + label: 'open graphic in a window' translatedNoop - label: 'open graphic in a window' selector: #openImageInWindow: + description: 'open a graphic file in a window' translatedNoop + buttonLabel: 'open' translatedNoop! - description: 'open a graphic file in a window' - buttonLabel: 'open'!
Item was changed: ----- Method: Form class>>services (in category 'file list services') ----- services
+ | a | + a _ Array with: self serviceOpenImageInWindow. + + Preferences eToyFriendly ifFalse: [ + a _ (Array with: self serviceImageAsBackground with: self serviceImageImports), a. + ]. + ^ a. + + ! - ^ Array - with: self serviceImageImports - with: self serviceOpenImageInWindow - with: self serviceImageAsBackground !
Item was changed: ----- Method: GIFReadWriter>>readBitData (in category 'private-decoding') ----- readBitData "using modified Lempel-Ziv Welch algorithm."
| outCodes outCount bitMask initCodeSize code curCode oldCode inCode finChar i bytes f c packedBits hasLocalColor localColorSize maxOutCodes |
+ maxOutCodes _ 4096. - maxOutCodes := 4096. offset := self readWord@self readWord. "Image Left@Image Top" + width _ self readWord. + height _ self readWord. - width := self readWord. - height := self readWord.
"--- Local Color Table Flag 1 Bit Interlace Flag 1 Bit Sort Flag 1 Bit Reserved 2 Bits Size of Local Color Table 3 Bits ----" + packedBits _ self next. + interlace _ (packedBits bitAnd: 16r40) ~= 0. + hasLocalColor _ (packedBits bitAnd: 16r80) ~= 0. + localColorSize _ 1 bitShift: ((packedBits bitAnd: 16r7) + 1). + hasLocalColor ifTrue: [localColorTable _ self readColorTable: localColorSize]. - packedBits := self next. - interlace := (packedBits bitAnd: 16r40) ~= 0. - hasLocalColor := (packedBits bitAnd: 16r80) ~= 0. - localColorSize := 1 bitShift: ((packedBits bitAnd: 16r7) + 1). - hasLocalColor ifTrue: [localColorTable := self readColorTable: localColorSize].
+ pass _ 0. + xpos _ 0. + ypos _ 0. + rowByteSize _ ((width + 3) // 4) * 4. + remainBitCount _ 0. + bufByte _ 0. + bufStream _ ReadStream on: ByteArray new. - pass := 0. - xpos := 0. - ypos := 0. - rowByteSize := ((width + 3) // 4) * 4. - remainBitCount := 0. - bufByte := 0. - bufStream := ReadStream on: ByteArray new.
+ outCodes _ ByteArray new: maxOutCodes + 1. + outCount _ 0. + + prefixTable _ Array new: 4096. + suffixTable _ Array new: 4096. - outCodes := ByteArray new: maxOutCodes + 1. - outCount := 0. - bitMask := (1 bitShift: bitsPerPixel) - 1. - prefixTable := Array new: 4096. - suffixTable := Array new: 4096.
+ initCodeSize _ self next. + bitMask _ (1 bitShift: initCodeSize ) - 1. - initCodeSize := self next. - self setParameters: initCodeSize. bitsPerPixel > 8 ifTrue: [^self error: 'never heard of a GIF that deep']. + bytes _ ByteArray new: rowByteSize * height. + [(code _ self readCode) = eoiCode] whileFalse: - bytes := ByteArray new: rowByteSize * height. - [(code := self readCode) = eoiCode] whileFalse: [code = clearCode ifTrue: [self setParameters: initCodeSize. + curCode _ oldCode _ code _ self readCode. + finChar _ curCode bitAnd: bitMask. - curCode := oldCode := code := self readCode. - finChar := curCode bitAnd: bitMask. "Horrible hack to avoid running off the end of the bitmap. Seems to cure problem reading some gifs!!? tk 6/24/97 20:16" xpos = 0 ifTrue: [ ypos < height ifTrue: [ bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar]] ifFalse: [bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar]. self updatePixelPosition] ifFalse: + [curCode _ inCode _ code. - [curCode := inCode := code. curCode >= freeCode ifTrue: + [curCode _ oldCode. + outCodes at: (outCount _ outCount + 1) put: finChar]. - [curCode := oldCode. - outCodes at: (outCount := outCount + 1) put: finChar]. [curCode > bitMask] whileTrue: [outCount > maxOutCodes ifTrue: [^self error: 'corrupt GIF file (OutCount)']. + outCodes at: (outCount _ outCount + 1) - outCodes at: (outCount := outCount + 1) put: (suffixTable at: curCode + 1). + curCode _ prefixTable at: curCode + 1]. + finChar _ curCode bitAnd: bitMask. + outCodes at: (outCount _ outCount + 1) put: finChar. + i _ outCount. - curCode := prefixTable at: curCode + 1]. - finChar := curCode bitAnd: bitMask. - outCodes at: (outCount := outCount + 1) put: finChar. - i := outCount. [i > 0] whileTrue: ["self writePixel: (outCodes at: i) to: bits" bytes at: (ypos * rowByteSize) + xpos + 1 put: (outCodes at: i). self updatePixelPosition. + i _ i - 1]. + outCount _ 0. - i := i - 1]. - outCount := 0. prefixTable at: freeCode + 1 put: oldCode. suffixTable at: freeCode + 1 put: finChar. + oldCode _ inCode. + freeCode _ freeCode + 1. - oldCode := inCode. - freeCode := freeCode + 1. self checkCodeSize]]. + prefixTable _ suffixTable _ nil. - prefixTable := suffixTable := nil.
+ f _ ColorForm extent: width@height depth: 8. - f := ColorForm extent: width@height depth: 8. f bits copyFromByteArray: bytes. "Squeak can handle depths 1, 2, 4, and 8" bitsPerPixel > 4 ifTrue: [^ f]. "reduce depth to save space" + c _ ColorForm extent: width@height - c := ColorForm extent: width@height depth: (bitsPerPixel = 3 ifTrue: [4] ifFalse: [bitsPerPixel]). f displayOn: c. ^ c !
Item was changed: ----- Method: JPEGReadWriter class>>typicalFileExtensions (in category 'image reading/writing') ----- typicalFileExtensions "Answer a collection of file extensions (lowercase) which files that I can read might commonly have" + ^#('jpg' 'jpeg' 'jpe')! - ^#('jpg' 'jpeg')!
Item was changed: ----- Method: JPEGReadWriter2 class>>typicalFileExtensions (in category 'image reading/writing') ----- typicalFileExtensions "Answer a collection of file extensions (lowercase) which files that I can read might commonly have" + ^#('jpg' 'jpeg' 'jpe')! - ^#('jpg' 'jpeg')!