'From Squeak3.1alpha [latest update: #''Squeak3.1alpha'' of 5 February 2001 update 3951] on 25 April 2001 at 9:32:33 am'! "Change Set: gifFix Date: 25 April 2001 Author: Bob Arning Fix some problems reading GIFs: - local color tables are now supported. - size of outCodes increased to handle larger images - handling of transparentIndex fixed"! ImageReadWriter subclass: #GIFReadWriter instanceVariableNames: 'width height bitsPerPixel depth colorPalette rowByteSize xpos ypos pass interlace codeSize clearCode eoiCode freeCode maxCode prefixTable suffixTable remainBitCount bufByte bufStream transparentIndex mapOf32 localColorTable ' classVariableNames: 'Extension ImageSeparator Terminator ' poolDictionaries: '' category: 'Graphics-Files'! !GIFReadWriter methodsFor: 'accessing' stamp: 'RAA 4/25/2001 09:31'! nextImage "Read in the next GIF image from the stream. Read it all into memory first for speed." | f thisImageColorTable | stream class == ReadWriteStream ifFalse: [ (stream respondsTo: #binary) ifTrue: [stream binary]. self on: (ReadWriteStream with: (stream contentsOfEntireFile))]. localColorTable _ nil. self readHeader. f _ self readBody. self close. f == nil ifTrue: [^ self error: 'corrupt GIF file']. thisImageColorTable _ localColorTable ifNil: [colorPalette]. transparentIndex ifNotNil: [ transparentIndex + 1 > thisImageColorTable size ifTrue: [ thisImageColorTable _ thisImageColorTable forceTo: transparentIndex + 1 paddingWith: Color white ]. thisImageColorTable at: transparentIndex + 1 put: Color transparent ]. f colors: thisImageColorTable. ^ f ! ! !GIFReadWriter methodsFor: 'private-decoding' stamp: 'RAA 4/25/2001 09:31'! 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. self readWord. "skip Image Left" self readWord. "skip Image Top" 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]. 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. bitMask _ (1 bitShift: bitsPerPixel) - 1. prefixTable _ Array new: 4096. suffixTable _ Array new: 4096. 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: [code = clearCode ifTrue: [self setParameters: initCodeSize. 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 >= freeCode ifTrue: [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) put: (suffixTable at: curCode + 1). 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. prefixTable at: freeCode + 1 put: oldCode. suffixTable at: freeCode + 1 put: finChar. oldCode _ inCode. freeCode _ freeCode + 1. self checkCodeSize]]. prefixTable _ suffixTable _ nil. 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 depth: (bitsPerPixel = 3 ifTrue: [4] ifFalse: [bitsPerPixel]). f displayOn: c. ^ c ! ! !GIFReadWriter methodsFor: 'private-decoding' stamp: 'RAA 4/25/2001 09:30'! readBody "Read the GIF blocks. Modified to return a form. " | form extype block blocksize packedFields | form _ nil. [stream atEnd] whileFalse: [ block _ self next. block = Terminator ifTrue: [^ form]. block = ImageSeparator ifTrue: [ form isNil ifTrue: [form _ self readBitData] ifFalse: [self skipBitData]. ] ifFalse: [ block = Extension ifFalse: [^ form "^ self error: 'Unknown block type'"]. "Extension block" extype _ self next. "extension type" extype = 16rF9 ifTrue: [ "graphics control" self next = 4 ifFalse: [^ form "^ self error: 'corrupt GIF file'"]. "==== Reserved 3 Bits Disposal Method 3 Bits User Input Flag 1 Bit Transparent Color Flag 1 Bit ===" packedFields _ self next. self next. "delay time 1" self next. "delay time 2" transparentIndex _ self next. (packedFields bitAnd: 1) = 0 ifTrue: [transparentIndex _ nil]. self next = 0 ifFalse: [^ form "^ self error: 'corrupt GIF file'"]. ] ifFalse: [ "Skip blocks" [(blocksize _ self next) > 0] whileTrue: [self next: blocksize]]]]. ! ! !GIFReadWriter methodsFor: 'private-decoding' stamp: 'RAA 4/25/2001 08:48'! readColorTable: numberOfEntries | array r g b | array _ Array new: numberOfEntries. 1 to: array size do: [ :i | r _ self next. g _ self next. b _ self next. array at: i put: (Color r: r g: g b: b range: 255) ]. ^array! ! !GIFReadWriter methodsFor: 'private-decoding' stamp: 'RAA 4/25/2001 08:49'! readHeader | is89 byte hasColorMap | (self hasMagicNumber: 'GIF87a' asByteArray) ifTrue: [is89 _ false] ifFalse: [(self hasMagicNumber: 'GIF89a' asByteArray) ifTrue: [is89 _ true] ifFalse: [^ self error: 'This does not appear to be a GIF file']]. self readWord. "skip Screen Width" self readWord. "skip Screen Height" byte _ self next. hasColorMap _ (byte bitAnd: 16r80) ~= 0. bitsPerPixel _ (byte bitAnd: 7) + 1. byte _ self next. "skip background color." self next ~= 0 ifTrue: [is89 ifFalse: [^self error: 'corrupt GIF file (screen descriptor)']]. hasColorMap ifTrue: [colorPalette _ self readColorTable: (1 bitShift: bitsPerPixel)] ifFalse: ["Transcript cr; show: 'GIF file does not have a color map.'." colorPalette _ nil "Palette monochromeDefault"].! !