From VisualWorks®, 7.2.1 of June 5, 2004 on June 5, 2004 at 2:30:55 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>ArborGIFImageReader</name> <environment>Graphics</environment> <super>Graphics.ImageReader</super> <private>false</private> none <imports></imports> <category>Arbor GIF Reader Writer</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> </class> <comment> Graphics.ArborGIFImageReader
This class has not yet been commented. The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable. The comment should also explain any unobvious aspects of the implementation. Instance Variables:
</comment> <class> <name>ArborImageReaderWriter</name> <environment>Graphics</environment> <super>Core.Object</super> <private>false</private> none stream <imports></imports> <category>Arbor GIF Reader Writer</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> </class> <comment> Graphics.ArborImageReaderWriter
This class was derived from the ImageReadWriter class contained in the Smallwalker distribution. Smallwalker is distributed under the GNU license agreement. As such, the source code for this class is also covered under the GNU agreement. The original ImageReadWriter class is Copyright © Kazuki Yasumatsu, 1995. All rights reserved. This class is Copyright © 1997, Arbor Intelligent Systems, Inc. All rights reserved. I am an abstract class to provide for encoding and/or decoding an image on a stream. Instance Variables: stream <ClassOfVariable> description of variable's function Class Variables: ImageNotStoredSignal <ClassOfVariable> description of variable''s function MagicNumberErrorSignal <ClassOfVariable> description of variable''s function
</comment> <class> <name>ArborGIFReaderWriter</name> <environment>Graphics</environment> <super>Graphics.ArborImageReaderWriter</super> <private>false</private> none width height bitsPerPixel colorPalette rowByteSize xpos ypos pass interlace codeSize clearCode eoiCode freeCode maxCode prefixTable suffixTable remainBitCount bufByte bufStream transparentIndex <imports></imports> <category>Arbor GIF Reader Writer</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> </class> <comment> Graphics.ArborGIFReaderWriter
This class was derived from the GIFReadWriter class contained in the Smallwalker distribution. Smallwalker is distributed under the GNU license agreement. As such, the source code for this class is also covered under the GNU agreement. The original GIFReadWriter class is Copyright © Kazuki Yasumatsu, 1995. All rights reserved. This class is Copyright © 1997, Arbor Intelligent Systems, Inc. All rights reserved. Instance Variables: width <ClassOfVariable> description of variable's function height <ClassOfVariable> description of variable's function bitsPerPixel <ClassOfVariable> description of variable's function colorPalette <ClassOfVariable> description of variable's function rowByteSize <ClassOfVariable> description of variable's function xpos <ClassOfVariable> description of variable's function ypos <ClassOfVariable> description of variable's function pass <ClassOfVariable> description of variable's function interlace <ClassOfVariable> description of variable's function codeSize <ClassOfVariable> description of variable's function clearCode <ClassOfVariable> description of variable's function eoiCode <ClassOfVariable> description of variable's function freeCode <ClassOfVariable> description of variable's function maxCode <ClassOfVariable> description of variable's function prefixTable <ClassOfVariable> description of variable's function suffixTable <ClassOfVariable> description of variable's function remainBitCount <ClassOfVariable> description of variable's function bufByte <ClassOfVariable> description of variable's function bufStream <ClassOfVariable> description of variable's function transparentIndex <ClassOfVariable> description of variable's function Class Variables: Extension <ClassOfVariable> description of variable''s function ImageSeparator <ClassOfVariable> description of variable''s function Terminator <ClassOfVariable> description of variable''s function
</comment> <class> <name>ArborShapeRenderer</name> <environment>Graphics</environment> <super>Graphics.NearestPaint</super> <private>false</private> none <imports></imports> <category>Arbor GIF Reader Writer</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> </class> <comment> Graphics.ArborShapeRenderer
This class was derived from the ShapeRenderer class contained in the Smallwalker distribution. Smallwalker is distributed under the GNU license agreement. As such, the source code for this class is also covered under the GNU agreement. The original ShapeRenderer class is Copyright © Kazuki Yasumatsu, 1995. All rights reserved. This class is Copyright © 1997, Arbor Intelligent Systems, Inc. All rights reserved. Instance Variables: Class Variables: BlackPixel <ClassOfVariable> description of variable''s function WhitePixel <ClassOfVariable> description of variable''s function
</comment> <name>WhitePixel</name> <environment>Graphics.ArborShapeRenderer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> <name>BlackPixel</name> <environment>Graphics.ArborShapeRenderer</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> <name>ImageSeparator</name> <environment>Graphics.ArborGIFReaderWriter</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> <name>Extension</name> <environment>Graphics.ArborGIFReaderWriter</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> <name>Terminator</name> <environment>Graphics.ArborGIFReaderWriter</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> <name>ImageNotStoredSignal</name> <environment>Graphics.ArborImageReaderWriter</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> <name>MagicNumberErrorSignal</name> <environment>Graphics.ArborImageReaderWriter</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>Arbor GIF Reader Writer</package> </attributes> <methods> Graphics.ArborGIFImageReader <category>initialize-release</category>
readImage Cursor read showWhile: [image := ArborGIFReaderWriter imageFrom: ioStream]
</methods> <methods> Graphics.ArborGIFImageReader <category>attributes</category>
format ^'GIF'
</methods> <methods> Graphics.ArborGIFImageReader class <category>private</category>
canRead: imageStream | result | imageStream reset. result := (imageStream next: 3) = #[16r47 16r49 16r46]. " the string 'GIF'" imageStream reset. ^result
</methods> <methods> Graphics.ArborImageReaderWriter <category>private</category>
changePadOfBits: bits width: width height: height depth: depth from: oldPad to: newPad "Change padding size of bits." | srcRowByteSize dstRowByteSize newBits srcRowBase rowEndOffset | (#(8 16 32) includes: oldPad) ifFalse: [^self error: 'Invalid pad: ', oldPad printString]. (#(8 16 32) includes: newPad) ifFalse: [^self error: 'Invalid pad: ', newPad printString]. srcRowByteSize := width * depth + oldPad - 1 // oldPad * (oldPad / 8). srcRowByteSize * height = bits size ifFalse: [^self error: 'Incorrect bitmap array size.']. dstRowByteSize := width * depth + newPad - 1 // newPad * (newPad / 8). newBits := ByteArray new: dstRowByteSize * height. srcRowBase := 1. rowEndOffset := dstRowByteSize - 1. 1 to: newBits size by: dstRowByteSize do: [:dstRowBase | newBits replaceFrom: dstRowBase to: dstRowBase + rowEndOffset with: bits startingAt: srcRowBase. srcRowBase := srcRowBase + srcRowByteSize]. ^newBits
colorValueFrom: rgbInteger "Answer a colorValue from a 3 byte integer that represents RGB." ^self class colorValueFrom: rgbInteger
hasMagicNumber: aByteArray | position | position := stream position. ((stream size - position) >= aByteArray size and: [(stream next: aByteArray size) = aByteArray]) ifTrue: [^true]. stream position: position. ^false
imageNotStoredError ^self class imageNotStoredSignal raise
magicNumberError ^self class magicNumberErrorSignal raise
on: aStream stream := aStream. (stream respondsTo: #binary) ifTrue: [stream binary]
packBits: bits depthFrom8To: depth with: width height: height pad: pad "Pack bits of depth 8 image to it of depth 1, 2, or 4 image." | maxPixelVal pixelInByte bitsWidth pBitsWidth pBits | (#(1 2 4) includes: depth) ifFalse: [^self error: 'depth must be 1, 2, or 4']. (#(8 16 32) includes: pad) ifFalse: [^self error: 'pad must be 8, 16, or 32']. maxPixelVal := (1 bitShift: depth) - 1. pixelInByte := 8 / depth. bitsWidth := width * 8 + pad - 1 // pad * (pad / 8). pBitsWidth := width * depth + pad - 1 // pad * (pad / 8). pBits := ByteArray new: pBitsWidth * height. 1 to: height do: [:i | | bitIndex pBitIndex pixelVal count | bitIndex := i - 1 * bitsWidth. pBitIndex := i - 1 * pBitsWidth. pixelVal := 0. count := 0. 1 to: width do: [:j | | val | val := bits at: (bitIndex := bitIndex + 1). val > maxPixelVal ifTrue: [^self error: 'can''t pack bits']. pixelVal := (pixelVal bitShift: depth) + val. (count := count + 1) >= pixelInByte ifTrue: [pBits at: (pBitIndex := pBitIndex + 1) put: pixelVal. pixelVal := 0. count := 0]]. count > 0 ifTrue: [pBits at: (pBitIndex := pBitIndex + 1) put: (pixelVal bitShift: depth * (pixelInByte - count))]]. ^pBits
rgbIntegerArrayFor: aPalette | colors | colors := Array new: aPalette maxIndex + 1. 1 to: colors size do: [:i | colors at: i put: (self rgbIntegerFrom: (aPalette at: i - 1 ifAbsent: [ColorValue white]))]. ^colors
rgbIntegerFrom: aColorValue "Answer a 3 byte integer that represents RGB from a colorValue." ^self class rgbIntegerFrom: aColorValue
scalingValue: value from: fromScale to: toScale ^self class scalingValue: value from: fromScale to: toScale
unpackBits: bits depthTo8From: depth with: width height: height pad: pad "Unpack bits of depth 1, 2, or 4 image to it of depth 8 image." | bitMask pixelInByte bitsWidth upBitsWidth stopWidth trailingSize upBits | (#(1 2 4) includes: depth) ifFalse: [^self error: 'depth must be 1, 2, or 4']. (#(8 16 32) includes: pad) ifFalse: [^self error: 'pad must be 8, 16, or 32']. bitMask := (1 bitShift: depth) - 1. pixelInByte := 8 / depth. bitsWidth := width * depth + pad - 1 // pad * (pad / 8). upBitsWidth := width * 8 + pad - 1 // pad * (pad / 8). stopWidth := width * depth + 7 // 8. trailingSize := width - (stopWidth - 1 * pixelInByte). upBits := ByteArray new: upBitsWidth * height. 1 to: height do: [:i | | bitIndex upBitIndex val | bitIndex := i - 1 * bitsWidth. upBitIndex := i - 1 * upBitsWidth. 1 to: stopWidth - 1 do: [:j | val := bits at: (bitIndex := bitIndex + 1). upBitIndex := upBitIndex + pixelInByte. 1 to: pixelInByte do: [:k | upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask). val := val bitShift: depth negated]]. val := (bits at: (bitIndex := bitIndex + 1)) bitShift: depth negated * (pixelInByte - trailingSize). upBitIndex := upBitIndex + trailingSize. 1 to: trailingSize do: [:k | upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask). val := val bitShift: depth negated]]. ^upBits
</methods> <methods> Graphics.ArborImageReaderWriter <category>stream access</category>
atEnd ^stream atEnd
close stream == nil ifFalse: [stream close]
contents ^stream contents
cr ^stream nextPut: Character cr asInteger
lf "PPM and PBM are used LF as CR." ^stream nextPut: Character lf asInteger
next ^stream next
next: size ^stream next: size
nextLong "Read a 32-bit quantity from the input stream." ^(stream next bitShift: 24) + (stream next bitShift: 16) + (stream next bitShift: 8) + stream next
nextLongPut: a32BitW "Write out a 32-bit integer as 32 bits." stream nextPut: ((a32BitW bitShift: -24) bitAnd: 16rFF). stream nextPut: ((a32BitW bitShift: -16) bitAnd: 16rFF). stream nextPut: ((a32BitW bitShift: -8) bitAnd: 16rFF). stream nextPut: (a32BitW bitAnd: 16rFF). ^a32BitW
nextPut: aByte ^stream nextPut: aByte
nextPutAll: aByteArray ^stream nextPutAll: aByteArray
nextWord "Read a 16-bit quantity from the input stream." ^(stream next bitShift: 8) + stream next
nextWordPut: a16BitW "Write out a 16-bit integer as 16 bits." stream nextPut: ((a16BitW bitShift: -8) bitAnd: 16rFF). stream nextPut: (a16BitW bitAnd: 16rFF). ^a16BitW
position ^stream position
position: anInteger ^stream position: anInteger
size ^stream size
skip: anInteger ^stream skip: anInteger
space ^stream nextPut: Character space asInteger
tab ^stream nextPut: Character tab asInteger
</methods> <methods> Graphics.ArborImageReaderWriter <category>accessing</category>
nextImage "Dencoding an image on stream and answer the image." ^self subclassResponsibility
nextImageFromFileNamed: aFileName "Dencoding an image stored on a file named aFileName." | image | stream := aFileName asFilename readStream binary. [image := self nextImage] ensure: [self close]. ^image
nextPutImage: anImage "Encoding anImage on stream." ^self subclassResponsibility
nextPutImage: anImage onFileNamed: aFileName "Encode anImage on a file named aFileName." | fname preExist | fname := aFileName asFilename. preExist := fname exists. stream := fname writeStream binary. [self nextPutImage: anImage] ifCurtailed: [self close. preExist ifFalse: [fname delete]]. self close. ^anImage
</methods> <methods> Graphics.ArborImageReaderWriter class <category>examples</category>
guessImageFrom: aStream "Answer an image stored on aStream." | position readerClasses image | position := aStream position. readerClasses := ArborImageReaderWriter allSubclasses copy. image := ArborImageReaderWriter magicNumberErrorSignal handle: [:ex | ex restart] do: [readerClasses isEmpty ifTrue: [nil] ifFalse: [aStream position: position. readerClasses removeFirst imageFrom: aStream]]. image notNil ifTrue: [^image]. "^self error: 'Unknown file format'" ^ArborImageReaderWriter magicNumberErrorSignal raise
guessImageFromFileNamed: aFileName "Answer an image stored on a file named aFileName." | readerClasses image | readerClasses := ArborImageReaderWriter allSubclasses copy. image := ArborImageReaderWriter magicNumberErrorSignal handle: [:ex | ex restart] do: [readerClasses isEmpty ifTrue: [nil] ifFalse: [readerClasses removeFirst imageFromFileNamed: aFileName]]. image notNil ifTrue: [^image]. "^self error: 'Unknown file format'" ^ArborImageReaderWriter magicNumberErrorSignal raise
imageFrom: aStream "Answer an image stored on aStream ." | reader image | reader := self on: aStream. Cursor read showWhile: [[image := reader nextImage] ensure: [reader close]]. ^image
imageFromFileNamed: aFileName "Answer an image stored on a file named aFileName." | reader image | reader := self new. Cursor read showWhile: [[image := reader nextImageFromFileNamed: aFileName] ensure: [reader close]]. ^image
openGuessImageFromFileNamed: aFileName | anImage cachedImage | anImage := self guessImageFromFileNamed: aFileName. (anImage isKindOf: OpaqueImage) ifTrue: [cachedImage := anImage] ifFalse: [cachedImage := CachedImage on: anImage]. ScheduledWindow new component: cachedImage; label: aFileName; minimumSize: anImage bounds extent; maximumSize: anImage bounds extent; open
openImageFromFileNamed: aFileName | anImage cachedImage | anImage := self imageFromFileNamed: aFileName. (anImage isKindOf: OpaqueImage) ifTrue: [cachedImage := anImage] ifFalse: [cachedImage := CachedImage on: anImage]. ScheduledWindow new component: cachedImage; label: aFileName; minimumSize: anImage bounds extent; maximumSize: anImage bounds extent; open
putImage: anImage "Answer a ByteArray on which anImage is encoded." | writer | writer := self on: (WriteStream on: (ByteArray new: 1024)). Cursor write showWhile: [[writer nextPutImage: anImage] ensure: [writer close]]. ^writer contents
putImage: anImage onFileNamed: aFileName "Encode anImage on a file named aFileName." | writer | writer := self new. Cursor write showWhile: [[writer nextPutImage: anImage onFileNamed: aFileName] ensure: [writer close]]. ^writer
</methods> <methods> Graphics.ArborImageReaderWriter class <category>instance creation</category>
on: aStream "Answer an instance of the receiver for encoding and/or decoding images on aStream." ^self new on: aStream
</methods> <methods> Graphics.ArborImageReaderWriter class <category>private</category>
colorValueFrom: rgbInteger "Answer a colorValue from a 3 byte integer that represents RGB." | scalingValue | scalingValue := ColorValue scalingValue. ^ColorValue scaledRed: (self scalingValue: ((rgbInteger bitShift: -16) bitAnd: 255) from: 255 to: scalingValue) scaledGreen: (self scalingValue: ((rgbInteger bitShift: -8) bitAnd: 255) from: 255 to: scalingValue) scaledBlue: (self scalingValue: (rgbInteger bitAnd: 255) from: 255 to: scalingValue)
rgbIntegerFrom: aColorValue "Answer a 3 byte integer that represents RGB from a colorValue." | scalingValue | scalingValue := ColorValue scalingValue. ^((self scalingValue: aColorValue scaledRed from: scalingValue to: 255) bitShift: 16) + ((self scalingValue: aColorValue scaledGreen from: scalingValue to: 255) bitShift: 8) + (self scalingValue: aColorValue scaledBlue from: scalingValue to: 255)
scalingValue: value from: fromScale to: toScale ^value = 0 ifTrue: [0] ifFalse: [value = fromScale ifTrue: [toScale] ifFalse: [(value + 1 * (toScale + 1) / (fromScale + 1)) rounded - 1 max: 0]]
</methods> <methods> Graphics.ArborImageReaderWriter class <category>signal constants</category>
imageNotStoredSignal ^ImageNotStoredSignal
magicNumberErrorSignal ^MagicNumberErrorSignal
</methods> <methods> Graphics.ArborImageReaderWriter class <category>class initialization</category>
initialize "self initialize." self initializeSignals
initializeSignals "self initializeSignals" MagicNumberErrorSignal := Object errorSignal newSignal notifierString: 'Invalid magic number'; nameClass: self message: #magicNumberErrorSignal. ImageNotStoredSignal := Object errorSignal newSignal notifierString: 'Image not stored'; nameClass: self message: #imageNotStoredSignal.
</methods> <methods> Graphics.ArborGIFReaderWriter <category>private-encoding</category>
flushCode self flushBits
readPixelFrom: bits | pixel | ypos >= height ifTrue: [^nil]. pixel := bits at: (ypos * rowByteSize + xpos + 1). self updatePixelPosition. ^pixel
writeBitData: bits "using modified Lempel-Ziv Welch algorithm." | maxBits maxMaxCode tSize initCodeSize ent tShift fCode pixel byte | 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. 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: [| index disp nomatch | 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"
writeCode: aCode self nextBitsPut: aCode
writeCodeAndCheckCodeSize: aCode self writeCode: aCode. self checkCodeSize
writeGraphicsControlBlock "If my transparentIndex is non-nil, then write out transparency information." transparentIndex isNil ifTrue: [^self]. self nextPut: Extension; nextPut: 16rf9; "graphics control" nextPut: 4; "4 bytes long" nextPut: 1; nextPut: 0; nextPut: 0; nextPut: transparentIndex; nextPut: 0. "terminator"
writeHeader | byte array | self nextPutAll: 'GIF87a' 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. "null (future expansion)" array := self rgbIntegerArrayFor: colorPalette. array do: [:rgb | self nextPut: ((rgb bitShift: -16) bitAnd: 255); nextPut: ((rgb bitShift: -8) bitAnd: 255); nextPut: (rgb bitAnd: 255)]. array size + 1 to: (1 bitShift: bitsPerPixel) do: [:i | self nextPut: 0; nextPut: 0; nextPut: 0].
writeWord: aWord self nextPut: (aWord bitAnd: 255). self nextPut: ((aWord bitShift: -8) bitAnd: 255). ^aWord
</methods> <methods> Graphics.ArborGIFReaderWriter <category>private-decoding</category>
readBitData "using modified Lempel-Ziv Welch algorithm." | bits outCodes outCount bitMask initCodeSize code curCode oldCode inCode finChar | self readWord. "skip Image Left" self readWord. "skip Image Top" width := self readWord. height := self readWord. interlace := (self next bitAnd: 16r40) ~= 0. "I ignore the possible existence of a local color map." pass := 0. xpos := 0. ypos := 0. rowByteSize := width * 8 + 7 // 8. remainBitCount := 0. bufByte := 0. bufStream := ReadStream on: ByteArray new. bits := ByteArray new: width * height. outCodes := ByteArray new: 1025. outCount := 0. bitMask := (1 bitShift: bitsPerPixel) - 1. prefixTable := Array new: 4096. suffixTable := Array new: 4096. initCodeSize := self next. self setParameters: initCodeSize. [(code := self readCode) = eoiCode] whileFalse: [code = clearCode ifTrue: [self setParameters: initCodeSize. curCode := oldCode := code := self readCode. finChar := curCode bitAnd: bitMask. self writePixel: finChar to: bits] ifFalse: [curCode := inCode := code. curCode >= freeCode ifTrue: [curCode := oldCode. outCodes at: (outCount := outCount + 1) put: finChar]. [curCode > bitMask] whileTrue: [outCount > 1024 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. outCount to: 1 by: -1 do: [:i | self writePixel: (outCodes at: i) to: bits]. outCount := 0. prefixTable at: freeCode + 1 put: oldCode. suffixTable at: freeCode + 1 put: finChar. oldCode := inCode. freeCode := freeCode + 1. self checkCodeSize]]. prefixTable := suffixTable := nil. ^bits
readBody | bit | bit := nil. "Read Extension" [stream atEnd] whileFalse: [| extype block blocksize | block := self next. block = Terminator ifTrue: [^bit]. block = ImageSeparator ifTrue: [bit isNil ifTrue: [bit := self readBitData] ifFalse: [self skipBitData]] ifFalse: [block = Extension ifFalse: [^bit "^self error: 'Unknown block type'"]. "Extension block" extype := self next. "extension type" extype = 16rf9 "graphics control" ifTrue: [self next = 4 ifFalse: [^bit "^self error: 'corrupt GIF file'"]. self next; next; next. transparentIndex := self next. self next = 0 ifFalse: [^bit "^self error: 'corrupt GIF file'"]] ifFalse: "Skip blocks" [[(blocksize := self next) > 0] whileTrue: [self next: blocksize]]]]
readCode ^self nextBits
readHeader | is89 byte hasColorMap | (self hasMagicNumber: 'GIF87a' asByteArray) ifTrue: [is89 := false] ifFalse: [(self hasMagicNumber: 'GIF89a' asByteArray) ifTrue: [is89 := true] ifFalse: [^self magicNumberError]]. 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: [| array | array := Array new: (1 bitShift: bitsPerPixel). 1 to: array size do: [:i | array at: i put: (self colorValueFrom: (self next bitShift: 16) + (self next bitShift: 8) + self next)]. colorPalette := MappedPalette withColors: array] ifFalse: ["Transcript cr; show: 'GIF file does not have a colo rmap.'." colorPalette := MappedPalette monochromeDefault].
readWord ^self next + (self next bitShift: 8)
skipBitData | misc blocksize | self readWord. "skip Image Left" self readWord. "skip Image Top" self readWord. "width" self readWord. "height" misc := self next. (misc bitAnd: 16r80) = 0 ifFalse: "skip colormap" [1 to: (1 bitShift: (misc bitAnd: 7)+1) do: [:i | self next; next; next]]. self next. "minimum code size" [(blocksize := self next) > 0] whileTrue: [self next: blocksize]
writePixel: pixel to: bits | index | (index := ypos * rowByteSize + xpos + 1) <= bits size ifTrue: [bits at: index put: pixel]. self updatePixelPosition
</methods> <methods> Graphics.ArborGIFReaderWriter <category>private-bits access</category>
flushBits remainBitCount = 0 ifFalse: [self nextBytePut: bufByte. remainBitCount := 0]. self flushBuffer
nextBits | integer readBitCount shiftCount byte | integer := 0. remainBitCount = 0 ifTrue: [readBitCount := 8. shiftCount := 0] ifFalse: [readBitCount := remainBitCount. shiftCount := remainBitCount - 8]. [readBitCount < codeSize] whileTrue: [byte := self nextByte. byte == nil ifTrue: [^eoiCode]. integer := integer + (byte bitShift: shiftCount). shiftCount := shiftCount + 8. readBitCount := readBitCount + 8]. (remainBitCount := readBitCount - codeSize) = 0 ifTrue: [byte := self nextByte] ifFalse: [byte := self peekByte]. byte == nil ifTrue: [^eoiCode]. ^(integer + (byte bitShift: shiftCount)) bitAnd: maxCode
nextBitsPut: anInteger | integer writeBitCount shiftCount | shiftCount := 0. remainBitCount = 0 ifTrue: [writeBitCount := 8. integer := anInteger] ifFalse: [writeBitCount := remainBitCount. integer := bufByte + (anInteger bitShift: 8 - remainBitCount)]. [writeBitCount < codeSize] whileTrue: [self nextBytePut: ((integer bitShift: shiftCount) bitAnd: 255). shiftCount := shiftCount - 8. writeBitCount := writeBitCount + 8]. (remainBitCount := writeBitCount - codeSize) = 0 ifTrue: [self nextBytePut: (integer bitShift: shiftCount)] ifFalse: [bufByte := integer bitShift: shiftCount]. ^anInteger
</methods> <methods> Graphics.ArborGIFReaderWriter <category>private-packing</category>
fillBuffer | packSize | packSize := self next. bufStream := ReadStream on: (self next: packSize)
flushBuffer bufStream isEmpty ifTrue: [^self]. self nextPut: bufStream size. self nextPutAll: bufStream contents. bufStream := WriteStream on: (ByteArray new: 256)
nextByte bufStream atEnd ifTrue: [self atEnd ifTrue: [^nil]. self fillBuffer]. ^bufStream next
nextBytePut: aByte bufStream nextPut: aByte. bufStream size >= 254 ifTrue: [self flushBuffer]
peekByte bufStream atEnd ifTrue: [self atEnd ifTrue: [^nil]. self fillBuffer]. ^bufStream peek
</methods> <methods> Graphics.ArborGIFReaderWriter <category>private</category>
checkCodeSize (freeCode > maxCode and: [codeSize < 12]) ifTrue: [codeSize := codeSize + 1. maxCode := (1 bitShift: codeSize) - 1]
convertToImage: graphicThing "May be given an Image, CachedImage, Pixmap, Window (or any DisplaySuface), or OpaqueImage. If OpaqueImage, rebuild the image with a 'transparent' color in the masked areas and set the transparentIndex." | oi newPalette colors | (graphicThing isKindOf: OpaqueImage) not ifTrue: [^graphicThing asImage]. "If we get to this point then we know that the graphicThing is an OpaqueImage. We want to be able to generate a GIF with transparency based on the mask, so here we go...." "We need to define a palette entry as the transparent color by either a) adding a new otherwise unused color to the palette, or b) locating a color in the palette that is unused, Then answer a new image with the masked area set to the transparency color." oi := OpaqueImage figure: graphicThing figure asImage shape: graphicThing shape asImage. oi figure bitsPerPixel > 8 ifTrue: [^self imageNotStoredError]. colors := oi figure uniqueColorValues. colors add: ColorValue black. "Be sure it has black." colors := #(nil), colors asArray. "Save a slot for the transparent color." ^colors size <= 256 "Is the palette still 8-bit?" ifTrue: [| newEntry newFigure newShape | "Create a palette that has the newly generated transparent color in the first palette slot and black in the last palette slot. This enables us to then use the mask in a BitBlt operation and transfer only the unmasked portions of the figure out of the opaque image. Much nicer than painting to a PixMap and fetching the result back in." colors := colors copyWithout: ColorValue black. colors := colors, (Array new: 256 - colors size). colors at: 256 put: ColorValue black. newEntry := self createColorNotIn: colors. colors at: 1 put: newEntry. newPalette := MappedPalette withColors: colors. "Slot 1 is transparent, 256 is black" newFigure := oi figure copy convertToPalette: newPalette. "Prepare the shape so all bits are either transparent or black." newShape := oi shape copy. colors := Array new: newShape palette size withAll: newEntry. ((colors size - 1) / 2) rounded + 1 to: colors size do: [:i | colors at: i put: ColorValue black]. newShape palette: (MappedPalette withColors: colors). "Convert to the new palette - this makes transparent pixels 0 and black pixels 255." newShape := newShape convertToPalette: newPalette. "Now do a simple copy using the AND rule...." newShape copy: (0@0 extent: newShape extent) from: 0@0 in: newFigure rule: RasterOp and. newShape := newShape convertToPalette: (MappedPalette withColors: newPalette values asArray). transparentIndex := newShape palette keyAtValue: newEntry. newShape] ifFalse: [ "Darn, need to find an unused palette entry." (Dialog confirm: 'ArborGIFReaderWriter>>convertToImage: does not yet handle\full palettes. Use just the unmasked image?' withCRs) ifTrue: [oi figure] ifFalse: [self error: 'Full palette']]
createColorNotIn: aColorCollection "Create a ColorValue not in aColorCollection. The result must be a unique color where each RGB component can range from 0 to 255. Start using bright magenta (RGB = 255, 0, 255)." | colors | colors := aColorCollection asSet collect: [:cv | self rgbIntegerFrom: cv]. 255 to: 0 by: -1 do: [:red | 255 to: 0 by: -1 do: [:blue | 0 to: 255 do: [:green | (colors includes: ((red bitShift: 16) + (green bitShift: 8) + blue)) not ifTrue: [^ColorValue red: red/255 green: green/255 blue: blue/255]]]]. self error: 'The impossible has occurred.'.
setParameters: initCodeSize clearCode := 1 bitShift: initCodeSize. eoiCode := clearCode + 1. freeCode := clearCode + 2. codeSize := initCodeSize + 1. maxCode := (1 bitShift: codeSize) - 1
updatePixelPosition (xpos := xpos + 1) >= width ifFalse: [^self]. xpos := 0. interlace ifFalse: [ypos := ypos + 1. ^self]. pass = 0 ifTrue: [(ypos := ypos + 8) >= height ifTrue: [pass := pass + 1. ypos := 4]. ^self]. pass = 1 ifTrue: [(ypos := ypos + 8) >= height ifTrue: [pass := pass + 1. ypos := 2]. ^self]. pass = 2 ifTrue: [(ypos := ypos + 4) >= height ifTrue: [pass := pass + 1. ypos := 1]. ^self]. pass = 3 ifTrue: [ypos := ypos + 2. ^self]. ^self error: 'can''t happen'
</methods> <methods> Graphics.ArborGIFReaderWriter <category>accessing</category>
nextImage | bits depth figure shape shapeColors | [self readHeader. bits := self readBody. ] ensure: [self close]. bits == nil ifTrue: [^self error: 'corrupt GIF file']. depth := bitsPerPixel > 8 ifTrue: [^self error: 'can''t happen'] ifFalse: [bitsPerPixel = 1 ifTrue: [1] ifFalse: [bitsPerPixel = 2 ifTrue: [2] ifFalse: [bitsPerPixel <= 4 ifTrue: [4] ifFalse: [8]]]]. depth < 8 ifTrue: [bits := self packBits: bits depthFrom8To: depth with: width height: height pad: 8]. figure := Image extent: width@height depth: depth palette: colorPalette bits: bits pad: 8. (transparentIndex == nil or: [transparentIndex >= (1 bitShift: bitsPerPixel)]) ifTrue: [^figure]. shapeColors := Array new: (1 bitShift: bitsPerPixel) withAll: ColorValue black. shapeColors at: transparentIndex + 1 put: ColorValue white. shape := Image extent: width@height depth: depth palette: (MappedPalette withColors: shapeColors) bits: bits pad: 8. shape := shape convertToPalette: MappedPalette monochromeDefault renderedBy: ArborShapeRenderer new. shape palette: CoveragePalette monoMaskPalette. ^OpaqueImage figure: (CachedImage on: figure) shape: (CachedImage on: shape)
nextPutImage: someImage | bits anImage | anImage := self convertToImage: someImage. anImage bitsPerPixel > 8 ifTrue: [^self imageNotStoredError]. width := anImage width. height := anImage height. bitsPerPixel := anImage bitsPerPixel. colorPalette := anImage palette. bits := anImage bitsInstVar. bitsPerPixel < 8 ifTrue: [bits := self unpackBits: bits depthTo8From: bitsPerPixel with: anImage width height: anImage height pad: 32]. interlace := false. [self writeHeader. self writeGraphicsControlBlock. self writeBitData: bits. self nextPut: Terminator ] ensure: [self close]. ^anImage
</methods> <methods> Graphics.ArborGIFReaderWriter class <category>class initialization</category>
initialize "self initialize." ImageSeparator := $, asInteger. Extension := $! asInteger. Terminator := $; asInteger
</methods> <methods> Graphics.ArborShapeRenderer <category>rendering</category>
renderLuminance: luminance usingPalette: aPalette luminance = 1 ifTrue: [^aPalette indexOfPaintNearest: WhitePixel] ifFalse: [^aPalette indexOfPaintNearest: BlackPixel]
renderPaint: aColorValue usingPalette: aPalette aColorValue = WhitePixel ifTrue: [^aPalette indexOfPaintNearest: WhitePixel] ifFalse: [^aPalette indexOfPaintNearest: BlackPixel]
</methods> <methods> Graphics.ArborShapeRenderer <category>private-rendering</category>
genericPaletteRepresentImage: srcImage as: destImage paintTransfer: paintTransferBlockOrNil "Store a rendering of srcImage into destImage. If paintTransferBlockOrNil is non-nil, it should be a single-argument block used to transform each source paint in srcImage before applying the rendering algorithm. This version is generic and correct for all types of palettes. Answer destImage." | srcPalette destPalette srcPixels destPixels | srcPalette := srcImage palette. destPalette := destImage palette. srcPixels := srcImage pixelArraySpecies new: srcImage width. destPixels := destImage pixelArraySpecies new: destImage width. 0 to: srcImage height - 1 do: [:row | srcImage rowAt: row into: srcPixels. 1 to: srcImage width do: [:i | | srcPaint | srcPaint := srcPalette at: (srcPixels at: i) ifAbsent: [ColorValue black]. paintTransferBlockOrNil == nil ifFalse: [srcPaint := paintTransferBlockOrNil value: srcPaint]. destPixels at: i put: (self renderPaint: srcPaint usingPalette: destPalette)]. destImage rowAt: row putAll: destPixels]. ^destImage
smallPaletteRepresentImage: srcImage as: destImage paintTransfer: paintTransferBlockOrNil "Store a rendering of srcImage into destImage. If paintTransferBlockOrNil is non-nil, it should be a single-argument block used to transform each source paint in srcImage before applying the rendering algorithm. This version is specialized for small palettes. Answer destImage." | srcPalette destPalette srcPixels destPixels pixelMap | srcPalette := srcImage palette. destPalette := destImage palette. srcPixels := srcImage pixelArraySpecies new: srcImage width. destPixels := destImage pixelArraySpecies new: destImage width. pixelMap := destImage pixelArraySpecies new: srcPalette maxIndex + 1. 1 to: pixelMap size do: [:i | | srcPaint | srcPaint := srcPalette at: i - 1 ifAbsent: [ColorValue black]. paintTransferBlockOrNil == nil ifFalse: [srcPaint := paintTransferBlockOrNil value: srcPaint]. pixelMap at: i put: (self renderPaint: srcPaint usingPalette: destPalette)]. 0 to: srcImage height - 1 do: [:row | srcImage rowAt: row into: srcPixels. 1 to: srcImage width do: [:i | destPixels at: i put: (pixelMap at: (srcPixels at: i) + 1)]. destImage rowAt: row putAll: destPixels]. ^destImage
</methods> <methods> Graphics.ArborShapeRenderer class <category>class initialization</category>
initialize "self initialize." WhitePixel := ColorValue white. BlackPixel := ColorValue black.
</methods> <initialize> Graphics.ArborImageReaderWriter </initialize> <initialize> Graphics.ArborGIFReaderWriter </initialize> <initialize> Graphics.ArborShapeRenderer </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>NearestPaint</name> <environment>Graphics</environment> <super>Graphics.PaintRenderer</super> <private>false</private> none <imports></imports> <category>Graphics-Color Rendering</category> <attributes> <package>Graphics-Color Rendering</package> </attributes> </class> <class> <name>ImageReader</name> <environment>Graphics</environment> <super>Core.Object</super> <private>false</private> none ioStream image palette imageData width height bitsPerPixel bytesPerRow rowEndOffset <imports></imports> <category>Graphics-Images</category> <attributes> <package>Graphics-Images</package> </attributes> </class>