[squeak-dev] The Trunk: Graphics-tfel.361.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Aug 31 12:51:33 UTC 2016


Tim Felgentreff uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-tfel.361.mcz

==================== Summary ====================

Name: Graphics-tfel.361
Author: tfel
Time: 18 August 2016, 5:43:29.688286 pm
UUID: 5549d092-1850-4b4a-91e7-28aa271ebe0a
Ancestors: Graphics-mt.360, Graphics-tfel.358

merge trunk

=============== Diff against Graphics-mt.360 ===============

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 serviceImageImportAndShowImports
- 		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 at self readWord. "Image Left at 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 at height depth: 8.
- 	f := ColorForm extent: width at 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 at height
- 	c := ColorForm extent: width at 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')!



More information about the Squeak-dev mailing list