'From Cuis 2.3 of 22 March 2010 [latest update: #472] on 16 April 2010 at 10:10:39 am'!
!classDefinition: #PNGReadWriter category: #'Graphics-Files'!
ImageReadWriter subclass: #PNGReadWriter
	instanceVariableNames: 'chunk form width height depth backColor bitsPerChannel colorType interlaceMethod bitsPerPixel bytesPerScanline thisScanline prevScanline rowSize globalDataChunk unknownChunks palette transparentPixelValue filtersSeen cachedDecoderMap bigEndian auxCMap auxDest auxBitBlt auxSource '
	classVariableNames: 'BPP BlockHeight BlockWidth Debugging StandardColors StandardSwizzleMaps '
	poolDictionaries: ''
	category: 'Graphics-Files'!

!Bitmap methodsFor: 'accessing' stamp: 'jmv 4/15/2010 11:22'!
copyFromByteArray2: byteArray to: i
	"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].
	byteHack displayOn: myHack at:  0@i! !


!PNGReadWriter methodsFor: 'chunks' stamp: 'jmv 4/16/2010 10:08'!
processNonInterlaced
	| z filter temp copyMethod debug |
	debug := self debugging.
	copyMethod _ #(copyPixelsGray: nil copyPixelsRGB: copyPixelsIndexed:
		  copyPixelsGrayAlpha: nil copyPixelsRGBA:) at: colorType+1.
	debug ifTrue: [ Transcript cr; nextPutAll: 'NI chunk size='; print: chunk size ].
	z _ ZLibReadStream on: chunk from: 1 to: chunk size.
	prevScanline _ ByteArray new: bytesPerScanline.
	thisScanline := ByteArray new: bytesPerScanline.	

	(colorType = 0 and: [ bitsPerChannel < 16]) ifTrue: [
		auxSource _ Form extent: 1 @ (thisScanline size // 4) depth: 32 bits: thisScanline.
		auxDest _ Form extent: 1 @ (form bits size) depth: 32 bits: form bits.
		auxCMap _ Smalltalk isLittleEndian
			ifTrue:[ColorMap 
					shifts: #(-24 -8 8 24) 
					masks: #(16rFF000000 16r00FF0000 16r0000FF00 16r000000FF)].
		auxBitBlt _ (BitBlt toForm: auxDest)
			sourceForm: auxSource;
			colorMap: auxCMap;
			combinationRule: 3 ].

	0 to: height-1 do: [ :y |
		filter _ (z next: 1) first.
		debug ifTrue:[filtersSeen add: filter].
		thisScanline _ z next: bytesPerScanline into: thisScanline startingAt: 1.
		(debug and: [ thisScanline size < bytesPerScanline ]) ifTrue: [ Transcript nextPutAll: ('wanted {1} but only got {2}' format: { bytesPerScanline. thisScanline size }); cr ].
		filter = 0 ifFalse:[self filterScanline: filter count: bytesPerScanline].
		self perform: copyMethod with: y.
		temp := prevScanline.
		prevScanline := thisScanline.
		thisScanline := temp.
		].
	z atEnd ifFalse:[self error:'Unexpected data'].
	debug ifTrue: [Transcript  nextPutAll: ' compressed size='; print: z position  ].
! !

!PNGReadWriter methodsFor: 'chunks' stamp: 'jmv 4/15/2010 10:18'!
processTransparencyChunk

	| red green blue |

	"Transcript show: '  TRANSPARENCY ',chunk printString."
	colorType = 0 ifTrue: [
		transparentPixelValue _ chunk unsignedShortAt: 1 bigEndian: true.
		palette at: transparentPixelValue put: Color transparent.
		^self
	].
	colorType = 2 ifTrue: [
		red _ chunk at: 2.
		green _ chunk at: 2.
		blue _ chunk at: 2.
		transparentPixelValue _ 16rFF00 + red << 8 + green << 8 + blue.
		^self
	].
	colorType = 3 ifTrue: [
		chunk withIndexDo: [ :alpha :index |
			palette at: index put: ((palette at: index) alpha: alpha/255)
		].
		^self
	].
! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'jmv 4/16/2010 10:10'!
copyPixelsGray: y
	"Handle non-interlaced grayscale color mode (colorType = 0)"

	bitsPerChannel = 16 ifTrue: [
		"Warning: This is extremely slow. Besides we are downsampling to 8 bits!!"
		| blitter |
		blitter := BitBlt current bitPokerToForm: form.
		0 to: width - 1 do: [ :x |
			blitter pixelAt: x @ y put: 255 - (thisScanline at: x * 2 + 1) ].
			^self ].

	"Just copy the bits"

	"This interesting technique (By Andreas Raab) is a bit obscure, but it is so fast that we leave it active"
	^self copyPixelsGrayWeirdBitBltHack: y.

	"This interesting technique  (By Yoshiki Ohshima) is also instructive"
	"true ifTrue: [ ^form bits copyFromByteArray2: thisScanline to: y * (form width* bitsPerChannel // 32) ]."

	"This Smalltalk version might be easier to understand and is quite fast too."
	"This somewhat weird mixture of (#* and #+) with (#bitShift: and #bitOr:) 
	is to make use of faster arithmetic bytecodes, but not of slow largeintegers."
	"
	base _  y * form width * bitsPerChannel//32 +1.
	bits _ form bits.
	0 to: thisScanline size-1 // 4 do: [ :i |
		| ii word |
		ii _ i * 4.
		word _
	           ((thisScanline at: ii+1) *256 + 
	           (thisScanline at: ii+2) *256 + 
	           ((thisScanline at: ii+3)) bitShift: 8) bitOr: 
	           (thisScanline at: ii+4).
		bits at: base + i put: word.].
	"! !

!PNGReadWriter methodsFor: 'pixel copies' stamp: 'jmv 4/16/2010 10:02'!
copyPixelsGrayWeirdBitBltHack: y 
	"Handle non-interlaced black and white color mode (colorType = 0)
	By Andreas Raab"

	auxBitBlt
		destX: 0 destY: (y * form width*bitsPerChannel//32) width: 1 height: (form width+31*bitsPerChannel//32);
		copyBits.
! !

!PNGReadWriter methodsFor: 'miscellaneous' stamp: 'jmv 4/15/2010 10:19'!
grayColorsFor: d
	"return a color table for a gray image"

	palette _ Array new: 1<<d.
	d = 1 ifTrue: [
		palette at: 1 put: Color black.
		palette at: 2 put: Color white.
		^  palette
		].
	d = 2 ifTrue: [
		palette at: 1 put: Color black.
		palette at: 2 put: (Color gray: 85.0 / 255.0).
		palette at: 3 put: (Color gray: 170.0 / 255.0).
		palette at: 4 put: Color white.
		^ palette
		].
	d = 4 ifTrue: [
		0 to: 15 do: [ :g |
			palette at: g+1 put: (Color gray: (g/15) asFloat) ].
		^ palette
		].
	d = 8 ifTrue: [
		0 to: 255 do: [ :g |
			palette at: g+1 put: (Color gray: (g/255) asFloat) ].
		^ palette
		].
! !


!ZLibWriteStream class methodsFor: 'crc' stamp: 'ar 4/14/2010 19:50'!
updateAdler32: adler from: start to: stop in: aCollection
	"Update crc using the Adler32 checksum technique from RFC1950"
"
        unsigned long s1 = adler & 0xffff;
        unsigned long s2 = (adler >> 16) & 0xffff;
        int n;

        for (n = 0; n < len; n++) {
          s1 = (s1 + buf[n]) % BASE;
          s2 = (s2 + s1)     % BASE;
        }
        return (s2 << 16) + s1;
"
	| s1 s2 |
	<primitive: 'primitiveUpdateAdler32' module: 'ZipPlugin'>
	s1 := adler bitAnd: 16rFFFF.
	s2 := (adler bitShift: -16) bitAnd: 16rFFFF.
	start to: stop do: [ :n | | b |
		b := aCollection byteAt: n.
		s1 := (s1 + b) \\ 65521.
		s2 := (s2 + s1) \\ 65521. ].
	^(s2 bitShift: 16) + s1! !

!classDefinition: #PNGReadWriter category: #'Graphics-Files'!
ImageReadWriter subclass: #PNGReadWriter
	instanceVariableNames: 'chunk form width height depth backColor bitsPerChannel colorType interlaceMethod bitsPerPixel bytesPerScanline thisScanline prevScanline rowSize globalDataChunk unknownChunks palette transparentPixelValue filtersSeen cachedDecoderMap bigEndian auxBitBlt auxSource auxDest auxCMap'
	classVariableNames: 'BPP BlockHeight BlockWidth Debugging StandardColors StandardSwizzleMaps'
	poolDictionaries: ''
	category: 'Graphics-Files'!
