'From Squeak3.5beta of ''17 March 2003'' [latest update: #5174] on 29 May 2003 at 1:58:47 am'! "Change Set: GIFAnim-bf Date: 29 May 2003 Author: Bert Freudenberg Write animated GIFs - see GIFReadWriter>>exampleAnim. This is some old code (from 1996) resurrected. "! 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 delay loopCount ' classVariableNames: 'Extension ImageSeparator Terminator ' poolDictionaries: '' category: 'Graphics-Files'! !GIFReadWriter methodsFor: 'stream access' stamp: 'bf 5/29/2003 01:23'! close "Write terminator" self nextPut: Terminator. ^super close! ! !GIFReadWriter methodsFor: 'accessing' stamp: 'bf 5/29/2003 01:43'! delay: aNumberOrNil "Set delay for next image in hundredth (1/100) of seconds" delay := aNumberOrNil! ! !GIFReadWriter methodsFor: 'accessing' stamp: 'bf 5/29/2003 01:39'! loopCount: aNumber "Set looping. This must be done before any image is written!!" loopCount := aNumber! ! !GIFReadWriter methodsFor: 'accessing' stamp: 'bf 5/29/2003 01:20'! nextPutImage: aForm | f newF | aForm unhibernate. f _ aForm colorReduced. "minimize depth" f depth > 8 ifTrue: [ "Not enough color space; do it the hard way." f _ f asFormOfDepth: 8]. f depth < 8 ifTrue: [ "writeBitData: expects depth of 8" newF _ f class extent: f extent depth: 8. (f isKindOf: ColorForm) ifTrue: [ newF copyBits: f boundingBox from: f at: 0@0 clippingBox: f boundingBox rule: Form over fillColor: nil map: nil. newF colors: f colors] ifFalse: [f displayOn: newF]. f _ newF]. (f isKindOf: ColorForm) ifTrue: [ (f colorsUsed includes: Color transparent) ifTrue: [ transparentIndex _ (f colors indexOf: Color transparent) - 1]] ifFalse: [transparentIndex _ nil]. width _ f width. height _ f height. bitsPerPixel _ f depth. colorPalette _ f colormapIfNeededForDepth: 32. interlace _ false. self writeHeader. self writeBitData: f bits. ! ! !GIFReadWriter methodsFor: 'private-encoding' stamp: 'bf 5/29/2003 01:21'! writeBitData: bits "using modified Lempel-Ziv Welch algorithm." | maxBits maxMaxCode tSize initCodeSize ent tShift fCode pixel index disp nomatch | pass _ 0. xpos _ 0. ypos _ 0. rowByteSize _ width * 8 + 31 // 32 * 4. remainBitCount _ 0. bufByte _ 0. bufStream _ WriteStream on: (ByteArray new: 256). maxBits _ 12. maxMaxCode _ 1 bitShift: maxBits. tSize _ 5003. prefixTable _ Array new: tSize. suffixTable _ Array new: tSize. initCodeSize _ bitsPerPixel <= 1 ifTrue: [2] ifFalse: [bitsPerPixel]. self nextPut: initCodeSize. self setParameters: initCodeSize. tShift _ 0. fCode _ tSize. [fCode < 65536] whileTrue: [tShift _ tShift + 1. fCode _ fCode * 2]. tShift _ 8 - tShift. 1 to: tSize do: [:i | suffixTable at: i put: -1]. self writeCodeAndCheckCodeSize: clearCode. ent _ self readPixelFrom: bits. [(pixel _ self readPixelFrom: bits) == nil] whileFalse: [ fCode _ (pixel bitShift: maxBits) + ent. index _ ((pixel bitShift: tShift) bitXor: ent) + 1. (suffixTable at: index) = fCode ifTrue: [ent _ prefixTable at: index] ifFalse: [nomatch _ true. (suffixTable at: index) >= 0 ifTrue: [disp _ tSize - index + 1. index = 1 ifTrue: [disp _ 1]. "probe" [(index _ index - disp) < 1 ifTrue: [index _ index + tSize]. (suffixTable at: index) = fCode ifTrue: [ent _ prefixTable at: index. nomatch _ false. "continue whileFalse:"]. nomatch and: [(suffixTable at: index) > 0]] whileTrue: ["probe"]]. "nomatch" nomatch ifTrue: [self writeCodeAndCheckCodeSize: ent. ent _ pixel. freeCode < maxMaxCode ifTrue: [prefixTable at: index put: freeCode. suffixTable at: index put: fCode. freeCode _ freeCode + 1] ifFalse: [self writeCodeAndCheckCodeSize: clearCode. 1 to: tSize do: [:i | suffixTable at: i put: -1]. self setParameters: initCodeSize]]]]. prefixTable _ suffixTable _ nil. self writeCodeAndCheckCodeSize: ent. self writeCodeAndCheckCodeSize: eoiCode. self flushCode. self nextPut: 0. "zero-length packet" ! ! !GIFReadWriter methodsFor: 'private-encoding' stamp: 'bf 5/29/2003 01:38'! writeHeader | byte | stream position = 0 ifTrue: [ "For first image only" self nextPutAll: 'GIF89a' asByteArray. self writeWord: width. "Screen Width" self writeWord: height. "Screen Height" byte _ 16r80. "has color map" byte _ byte bitOr: ((bitsPerPixel - 1) bitShift: 5). "color resolution" byte _ byte bitOr: bitsPerPixel - 1. "bits per pixel" self nextPut: byte. self nextPut: 0. "background color." self nextPut: 0. "reserved" colorPalette do: [:pixelValue | self nextPut: ((pixelValue bitShift: -16) bitAnd: 255); nextPut: ((pixelValue bitShift: -8) bitAnd: 255); nextPut: (pixelValue bitAnd: 255)]. loopCount notNil ifTrue: [ "Write a Netscape loop chunk" self nextPut: Extension. self nextPutAll: #(255 11 78 69 84 83 67 65 80 69 50 46 48 3 1) asByteArray. self writeWord: loopCount. self nextPut: 0]]. delay notNil | transparentIndex notNil ifTrue: [ self nextPut: Extension; nextPutAll: #(16rF9 4) asByteArray; nextPut: (transparentIndex isNil ifTrue: [0] ifFalse: [9]); writeWord: (delay isNil ifTrue: [0] ifFalse: [delay]); nextPut: (transparentIndex isNil ifTrue: [0] ifFalse: [transparentIndex]); nextPut: 0]. self nextPut: ImageSeparator. self writeWord: 0. "Image Left" self writeWord: 0. "Image Top" self writeWord: width. "Image Width" self writeWord: height. "Image Height" byte _ interlace ifTrue: [16r40] ifFalse: [0]. self nextPut: byte. ! ! !GIFReadWriter class methodsFor: 'examples' stamp: 'bf 5/29/2003 01:56'! exampleAnim "GIFReadWriter exampleAnim" | writer extent center | writer := GIFReadWriter on: (FileStream newFileNamed: 'anim.gif'). writer loopCount: 20. "Repeat 20 times" writer delay: 10. "Wait 10/100 seconds" extent := 42@42. center := extent / 2. Cursor write showWhile: [ [2 to: center x - 1 by: 2 do: [:r | "Make a fancy anim without using Canvas - inefficient as hell" | image | image := ColorForm extent: extent depth: 8. 0.0 to: 359.0 do: [:theta | image colorAt: (center + (Point r: r degrees: theta)) rounded put: Color red]. writer nextPutImage: image] ] ensure: [writer close]].! ! ImageReadWriter subclass: #GIFReadWriter instanceVariableNames: 'width height bitsPerPixel colorPalette rowByteSize xpos ypos pass interlace codeSize clearCode eoiCode freeCode maxCode prefixTable suffixTable remainBitCount bufByte bufStream transparentIndex mapOf32 localColorTable delay loopCount ' classVariableNames: 'Extension ImageSeparator Terminator ' poolDictionaries: '' category: 'Graphics-Files'!