[Pkg] The Trunk: Graphics-fbs.221.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jul 25 07:30:25 UTC 2013


Frank Shearar uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-fbs.221.mcz

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

Name: Graphics-fbs.221
Author: fbs
Time: 25 July 2013, 8:29:39.711 am
UUID: 5be384b4-2d62-5c49-abb8-390dcb1881ab
Ancestors: Graphics-fbs.220

SmalltalkImage current -> Smalltalk.

=============== Diff against Graphics-fbs.220 ===============

Item was changed:
  ----- Method: Bitmap>>asByteArray (in category 'as yet unclassified') -----
  asByteArray
  	"Faster way to make a byte array from me.
  	copyFromByteArray: makes equal Bitmap."
  	| f bytes hack |
  	f := Form extent: 4 at self size depth: 8 bits: self.
  	bytes := ByteArray new: self size * 4.
  	hack := Form new hackBits: bytes.
+ 	Smalltalk isLittleEndian ifTrue:[hack swapEndianness].
- 	SmalltalkImage current isLittleEndian ifTrue:[hack swapEndianness].
  	hack copyBits: f boundingBox
  		from: f
  		at: (0 at 0)
  		clippingBox: hack boundingBox
  		rule: Form over
  		fillColor: nil
  		map: nil.
  
  	"f displayOn: hack."
  	^ bytes.
  !

Item was changed:
  ----- Method: Bitmap>>copyFromByteArray: (in category 'accessing') -----
  copyFromByteArray: byteArray 
  	"This method should work with either byte orderings"
  
  	| myHack byteHack |
  	myHack := Form new hackBits: self.
  	byteHack := Form new hackBits: byteArray.
+ 	Smalltalk  isLittleEndian ifTrue: [byteHack swapEndianness].
- 	SmalltalkImage current  isLittleEndian ifTrue: [byteHack swapEndianness].
  	byteHack displayOn: myHack!

Item was changed:
  ----- Method: Form>>readResourceFrom: (in category 'resources') -----
  readResourceFrom: aStream 
  	"Store a resource representation of the receiver on aStream.
  	Must be specific to the receiver so that no code is filed out."
  
  	| bitsSize msb |
  	(aStream next: 4) asString = self resourceTag 
  		ifFalse: 
  			[aStream position: aStream position - 4.
  			^self readNativeResourceFrom: aStream].
  	width := aStream nextNumber: 4.
  	height := aStream nextNumber: 4.
  	depth := aStream nextNumber: 4.
  	bitsSize := aStream nextNumber: 4.
  	bitsSize = 0 
  		ifFalse: 
  			[bits := aStream next: bitsSize.
  			^self].
  	msb := (aStream nextNumber: 4) = 1.
  	bitsSize := aStream nextNumber: 4.
  	bits := Bitmap new: self bitsSize.
  	(Form 
  		extent: width @ height
  		depth: depth
  		bits: (aStream next: bitsSize * 4)) displayOn: self.
+ 	msb = Smalltalk isBigEndian 
- 	msb = SmalltalkImage current  isBigEndian 
  		ifFalse: 
  			[Bitmap 
  				swapBytesIn: bits
  				from: 1
  				to: bits size]!

Item was changed:
  ----- Method: Form>>storeResourceOn: (in category 'resources') -----
  storeResourceOn: aStream
  	"Store a resource representation of the receiver on aStream.
  	Must be specific to the receiver so that no code is filed out."
  	self hibernate.
  	aStream nextPutAll: self resourceTag asByteArray. "tag"
  	aStream nextNumber: 4 put: width.
  	aStream nextNumber: 4 put: height.
  	aStream nextNumber: 4 put: depth.
  	(bits isMemberOf: ByteArray) ifFalse:[
  		"must store bitmap"
  		aStream nextNumber: 4 put: 0. "tag"
+ 		aStream nextNumber: 4 put: (Smalltalk isBigEndian ifTrue:[1] ifFalse:[0]).
- 		aStream nextNumber: 4 put: (SmalltalkImage current  isBigEndian ifTrue:[1] ifFalse:[0]).
  	].
  	aStream nextNumber: 4 put: bits size.
  	aStream nextPutAll: bits.
  !

Item was changed:
  ----- Method: MacOS9WindowProxy class>>isActiveHostWindowProxyClass (in category 'system startup') -----
  isActiveHostWindowProxyClass
  "Am I active?"
+ 	^Smalltalk platformName  = 'Mac OS' and: [Smalltalk osVersion asInteger < 1000]!
- 	^SmalltalkImage current platformName  = 'Mac OS' and: [SmalltalkImage current osVersion asInteger < 1000]!

Item was changed:
  ----- Method: MacOSXWindowProxy class>>isActiveHostWindowProxyClass (in category 'system startup') -----
  isActiveHostWindowProxyClass
  "Am I active?"
+ 	^Smalltalk platformName  = 'Mac OS' and: [Smalltalk osVersion asInteger >= 1000]!
- 	^SmalltalkImage current platformName  = 'Mac OS' and: [SmalltalkImage current osVersion asInteger >= 1000]!

Item was changed:
  ----- Method: MatrixTransform2x3>>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."
  
  	| w b1 b2 b3 b4 |
+ 	Smalltalk  isLittleEndian ifTrue: [
- 	SmalltalkImage current  isLittleEndian ifTrue: [
  		1 to: self basicSize do: [:i |
  			w := self basicAt: i.
  			b1 := w digitAt: 1.
  			b2 := w digitAt: 2.
  			b3 := w digitAt: 3.
  			b4 := w digitAt: 4.
  			w := (b1 << 24) + (b2 << 16) + (b3 << 8) + b4.
  			self basicAt: i put: w.
  		]
  	].
  
  !

Item was changed:
  ----- Method: PNGReadWriter>>nextImage (in category 'accessing') -----
  nextImage
+ 	bigEndian := Smalltalk isBigEndian.
- 	bigEndian := SmalltalkImage current isBigEndian.
  	filtersSeen := Bag new.
  	globalDataChunk := nil.
  	transparentPixelValue := nil.
  	unknownChunks := Set new.
  	stream reset.
  	stream binary.
  	stream skip: 8.
  	[stream atEnd] whileFalse: [self processNextChunk].
  	"Set up our form"
  	palette ifNotNil: 
  			["Dump the palette if it's the same as our standard palette"
  
  			palette = (StandardColors copyFrom: 1 to: palette size) 
  				ifTrue: [palette := nil]].
  	(depth <= 8 and: [palette notNil]) 
  		ifTrue: 
  			[form := ColorForm extent: width @ height depth: depth.
  			form colors: palette]
  		ifFalse: [form := Form extent: width @ height depth: depth].
  	backColor ifNotNil: [form fillColor: backColor].
  	chunk := globalDataChunk ifNil: [self error: 'image data is missing'].
  	chunk ifNotNil: [self processIDATChunk].
  	unknownChunks isEmpty 
  		ifFalse: 
  			["Transcript show: ' ',unknownChunks asSortedCollection asArray printString."
  
  			].
  	self debugging 
  		ifTrue: 
  			[Transcript
  				cr;
  				show: 'form = ' , form printString.
  			Transcript
  				cr;
  				show: 'colorType = ' , colorType printString.
  			Transcript
  				cr;
  				show: 'interlaceMethod = ' , interlaceMethod printString.
  			Transcript
  				cr;
  				show: 'filters = ' , filtersSeen sortedCounts asArray printString].
  	^form!

Item was changed:
  ----- Method: PNGReadWriter>>nextPutImage:interlace:filter: (in category 'writing') -----
  nextPutImage: aForm interlace: aMethod filter: aFilterType 
  	"Note: For now we keep it simple - interlace and filtering are simply ignored"
  
  	| crcStream |
+ 	bigEndian := Smalltalk isBigEndian.
- 	bigEndian := SmalltalkImage current isBigEndian.
  	form := aForm.
  	width := aForm width.
  	height := aForm height.
  	aForm depth <= 8 
  		ifTrue: 
  			[bitsPerChannel := aForm depth.
  			colorType := 3.
  			bytesPerScanline := (width * aForm depth + 7) // 8]
  		ifFalse: 
  			[bitsPerChannel := 8.
  			colorType := 6.
  			bytesPerScanline := width * 4].
  	self writeFileSignature.
  	crcStream := WriteStream on: (ByteArray new: 1000).
  	crcStream resetToStart.
  	self writeIHDRChunkOn: crcStream.
  	self writeChunk: crcStream.
  	form depth <= 8 
  		ifTrue: 
  			[crcStream resetToStart.
  			self writePLTEChunkOn: crcStream.
  			self writeChunk: crcStream.
  			form isColorForm 
  				ifTrue: 
  					[crcStream resetToStart.
  					self writeTRNSChunkOn: crcStream.
  					self writeChunk: crcStream]].
  	form depth = 16 
  		ifTrue: 
  			[crcStream resetToStart.
  			self writeSBITChunkOn: crcStream.
  			self writeChunk: crcStream].
  	crcStream resetToStart.
  	self writeIDATChunkOn: crcStream.
  	self writeChunk: crcStream.
  	crcStream resetToStart.
  	self writeIENDChunkOn: crcStream.
  	self writeChunk: crcStream!

Item was changed:
  ----- Method: Win32WindowProxy class>>isActiveHostWindowProxyClass (in category 'as yet unclassified') -----
  isActiveHostWindowProxyClass
  "Am I active?"
+ 	^Smalltalk platformName  = 'Win32'!
- 	^SmalltalkImage current platformName  = 'Win32'!



More information about the Packages mailing list