--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TIFFReader.st Fri Jul 16 11:42:12 1993 +0200
@@ -0,0 +1,1250 @@
+"
+ COPYRIGHT (c) 1991-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+ImageReader subclass:#TIFFReader
+ instanceVariableNames:'planarConfiguration
+ subFileType stripOffsets rowsPerStrip
+ fillOrder compression group3options predictor
+ stripByteCounts
+ currentOffset
+ stripOffsetsPos stripByteCountsPos bitsPerSamplePos
+ colorMapPos'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+TIFFReader comment:'
+
+COPYRIGHT (c) 1991-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+written Summer 91 by claus
+'!
+
+!TIFFReader class methodsFor:'documentation'!
+
+documentation
+"
+ This class knows how to read TIFF files (and will
+ learn sometime in the future how to write them).
+ Currently, not all formats are implemented and of
+ those that are, not all are tested.
+ It should work with most rgb, mono and 2-plane greyscale
+ images, since this is what I have as test material on
+ the NeXT.
+ It supports uncompressed, LZW and G3 compressed images;
+ JPEG is currently not implemented.
+ More formats and compressions will come ...
+"
+! !
+
+!TIFFReader methodsFor:'reading from file'!
+
+fromFile:aFileName
+ |char1 char2 version
+ numberOfTags "{ Class: SmallInteger }"
+ tagType "{ Class: SmallInteger }"
+ numberType "{ Class: SmallInteger }"
+ length "{ Class: SmallInteger }"
+ result offset ok|
+
+ inStream := FileStream readonlyFileNamed:aFileName.
+ inStream isNil ifTrue:[
+ 'open error' printNewline.
+ ^ nil
+ ].
+
+ char1 := inStream next.
+ char2 := inStream next.
+ (char1 ~~ char2) ifTrue:[
+ 'not a tiff file' printNewline.
+ inStream close.
+ ^ nil
+ ].
+ (char1 == $I) ifTrue:[
+ byteOrder := #lsb
+ ] ifFalse:[
+ (char1 == $M) ifTrue:[
+ byteOrder := #msb
+ ] ifFalse:[
+ 'not a tiff file' printNewline.
+ inStream close.
+ ^ nil
+ ]
+ ].
+
+ version := self readShort.
+ (version ~~ 42) ifTrue:[
+ 'version of tiff-file not supported' printNewline.
+ inStream close.
+ ^ nil
+ ].
+
+ "setup default values"
+
+ compression := 1. "none"
+ fillOrder := #msb.
+ planarConfiguration := 1.
+ photometric := nil.
+ bitsPerSample := 1.
+ samplesPerPixel := 1.
+ width := nil.
+ height := nil.
+ stripOffsets := nil.
+ rowsPerStrip := nil.
+ "resolutionUnit := 2."
+ predictor := 1.
+
+ offset := self readLong + 1.
+ inStream position:offset.
+
+ numberOfTags := self readShort.
+ 1 to:(numberOfTags) do:[:index |
+ tagType := self readShort.
+ numberType := self readShort.
+ length := self readLong.
+ self decodeTiffTag:tagType numberType:numberType
+ length:length
+ ].
+
+ offset := self readLong.
+ (offset ~~ 0) ifTrue:[
+ 'more tags ignored' printNewline
+ ].
+
+ ok := true.
+ width isNil ifTrue:[
+ 'missing width tag' printNewline.
+ ok := false
+ ].
+
+ height isNil ifTrue:[
+ 'missing length tag' printNewline.
+ ok := false
+ ].
+
+ photometric isNil ifTrue:[
+ 'missing photometric tag' printNewline.
+ ok := false
+ ].
+
+ stripOffsets isNil ifTrue:[
+ 'missing stripOffsets tag' printNewline.
+ ok := false
+ ].
+
+ ok ifFalse:[
+ inStream close.
+ ^ nil
+ ].
+
+ "given all the information, read the bits"
+
+ rowsPerStrip isNil ifTrue:[
+ rowsPerStrip := height
+ ].
+
+ (compression == 1) ifTrue:[
+ result := self readUncompressedTiffImageData
+ ] ifFalse:[
+ (compression == 5) ifTrue:[
+ result := self readLZWTiffImageData
+ ] ifFalse:[
+ (compression == 2) ifTrue:[
+ "result := self readCCITT3ModHuffmanTiffImageData"
+ 'ccitt mod Huffman compression not implemented' printNewline
+ ] ifFalse:[
+ (compression == 3) ifTrue:[
+ result := self readCCITTGroup3TiffImageData
+ ] ifFalse:[
+ (compression == 4) ifTrue:[
+ "result := self readCCITTGroup4TiffImageData"
+ 'ccitt group4 fax compression not implemented' printNewline
+ ] ifFalse:[
+ (compression == 32773) ifTrue:[
+ result := self readPackbitsTiffImageData
+ ] ifFalse:[
+ (compression == 32865) ifTrue:[
+ result := self readJPEGTiffImageData
+ ] ifFalse:[
+ 'compression type not known' printNewline
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ inStream close.
+ ^ result
+! !
+
+!TIFFReader methodsFor:'writing to file'!
+
+save:image onFile:aFileName
+ "save image as TIFF file on aFileName"
+
+ |pos1 pos|
+
+ outStream := FileStream newFileNamed:aFileName.
+ outStream isNil ifTrue:[
+ 'create error' printNewline.
+ ^ nil
+ ].
+
+ byteOrder := #msb.
+ fillOrder := #msb.
+ width := image width.
+ height := image height.
+ photometric := image photometric.
+ samplesPerPixel := image samplesPerPixel.
+ bitsPerSample := image bitsPerSample.
+ colorMap := image colorMap.
+ planarConfiguration := 1.
+ compression := 1. "none"
+ data := image bits.
+
+ "save as msb"
+
+ currentOffset := 0.
+
+ outStream nextPut:$M.
+ outStream nextPut:$M.
+ currentOffset := currentOffset + 2.
+
+ outStream binary.
+
+ self writeShort:42. "version"
+ currentOffset := currentOffset + 2.
+
+ pos1 := outStream position.
+ self writeLong:0. "start of commands - filled in later"
+ currentOffset := currentOffset + 4.
+
+ "output strips"
+
+ self writeBits. "this outputs bits as strips, sets stripOffsets and stripByteCounts"
+ self writeStripOffsets. "this outputs strip offsets, sets stripOffsetsPos"
+ self writeStripByteCounts. "this outputs strip bytecounts, sets stripByteCountPos"
+ self writeBitsPerSample. "this outputs bitsPerSample, sets bitsPerSamplePos"
+ photometric == #palette ifTrue:[
+ self writeColorMap "this outputs colorMap, sets colorMapPos"
+ ].
+
+ pos := outStream position. "backpatch tag offset"
+ outStream position:pos1.
+ self writeLong:(pos - 1).
+ outStream position:pos.
+('patch tag offset at: ', (pos1 printStringRadix:16) , ' to ',
+ (pos printStringRadix:16)) printNewline.
+
+ "output tag data"
+
+ photometric == #palette ifTrue:[
+ self writeShort:9
+ ] ifFalse:[
+ self writeShort:8. "8 tags"
+ ].
+ self writeTag:256. "image width"
+ self writeTag:257. "image height"
+ self writeTag:258. "bits per sample"
+ self writeTag:259. "compression"
+ self writeTag:262. "photometric"
+ self writeTag:273. "strip offsets"
+ self writeTag:279. "strip byte counts"
+ self writeTag:284. "planarconfig"
+ photometric == #palette ifTrue:[
+ self writeTag:320 "colorMap"
+ ].
+ self writeLong:0.
+
+ outStream close
+! !
+
+!TIFFReader methodsFor:'private'!
+
+readLongs:n
+ |oldPos offset values|
+
+ values := Array new:n.
+ (n == 1) ifTrue:[
+ values at:1 put:(self readLong)
+ ] ifFalse:[
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ 1 to:n do:[:index |
+ values at:index put:(self readLong)
+ ].
+ inStream position:oldPos
+ ].
+ ^ values
+!
+
+writeLongs:longs
+ 1 to:longs size do:[:l |
+ self writeLong:l
+ ]
+!
+
+readShorts:n
+ |oldPos offset values|
+
+ values := Array new:n.
+ (n <= 2) ifTrue:[
+ values at:1 put:(self readShort).
+ (n == 2) ifTrue:[
+ values at:2 put:(self readShort)
+ ] ifFalse:[
+ self readShort
+ ]
+ ] ifFalse:[
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ 1 to:n do:[:index |
+ values at:index put:(self readShort)
+ ].
+ inStream position:oldPos
+ ].
+ ^ values
+!
+
+readChars:n
+ |oldPos offset string|
+
+ string := String new:(n - 1).
+ (n <= 4) ifTrue:[
+ inStream nextBytes:(n - 1) into:string
+ ] ifFalse:[
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ inStream nextBytes:(n - 1) into:string.
+ inStream position:oldPos
+ ].
+ ^ string
+!
+
+readFracts:cnt
+ |oldPos offset values n d|
+
+ values := Array new:cnt.
+ offset := self readLong.
+ oldPos := inStream position.
+ inStream position:(offset + 1).
+ 1 to:cnt do:[:index |
+ n := self readLong.
+ d := self readLong.
+ values at:index put:(Fraction numerator:n denominator:d)
+ ].
+ inStream position:oldPos.
+ ^ values
+!
+
+decodeTiffTag:tagType numberType:numberType length:length
+ |offset value valueArray
+ val
+ n "{ Class: SmallInteger }" |
+
+ (numberType == 3) ifTrue:[
+ "short"
+ valueArray := self readShorts:length.
+ value := valueArray at:1
+ ] ifFalse:[
+ (numberType == 4) ifTrue:[
+ "integer"
+ valueArray := self readLongs:length.
+ value := valueArray at:1
+ ] ifFalse:[
+ (numberType == 2) ifTrue:[
+ "character"
+ value := self readChars:length
+ ] ifFalse:[
+ (numberType == 5) ifTrue:[
+ "fraction"
+ valueArray := self readFracts:length.
+ value := valueArray at:1
+ ] ifFalse:[
+ offset := self readLong
+ ]
+ ]
+ ]
+ ].
+
+ (tagType == 254) ifTrue:[
+ "NewSubfileType"
+ "newSubFileType := value."
+ 'newSubfiletype ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 255) ifTrue:[
+ "SubfileType"
+ subFileType := value.
+ 'subfiletype ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 256) ifTrue:[
+ "ImageWidth"
+ width := value.
+ 'width ' print. width printNewline.
+ ^ self
+ ].
+ (tagType == 257) ifTrue:[
+ "ImageHeight"
+ height := value.
+ 'height ' print. height printNewline.
+ ^ self
+ ].
+ (tagType == 258) ifTrue:[
+ "bitspersample"
+ bitsPerSample := valueArray.
+ 'bitspersample ' print. bitsPerSample printNewline.
+ ^ self
+ ].
+ (tagType == 259) ifTrue:[
+ "compression"
+ compression := value.
+ 'compression ' print. compression printNewline.
+ ^ self
+ ].
+ (tagType == 262) ifTrue:[
+ "photometric"
+ (value == 0) ifTrue:[
+ photometric := #whiteIs0
+ ] ifFalse:[
+ (value == 1) ifTrue:[
+ photometric := #blackIs0
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ photometric := #rgb
+ ] ifFalse:[
+ (value == 3) ifTrue:[
+ photometric := #palette
+ ] ifFalse:[
+ (value == 4) ifTrue:[
+ photometric := #transparency
+ ] ifFalse:[
+ photometric := nil
+ ]
+ ]
+ ]
+ ]
+ ].
+ 'photometric ' print. photometric printNewline.
+ ^ self
+ ].
+ (tagType == 263) ifTrue:[
+ "Treshholding"
+ "threshholding := value."
+ 'treshholding ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 264) ifTrue:[
+ "CellWidth"
+ "cellWidth:= value."
+ 'cellWidth ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 265) ifTrue:[
+ "CellLength"
+ "cellLength:= value."
+ 'cellLength ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 266) ifTrue:[
+ "fillOrder"
+ (value == 1) ifTrue:[
+ fillOrder := #msb
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ fillOrder := #lsb
+ ] ifFalse:[
+ fillOrder := nil
+ ]
+ ].
+ 'fillorder ' print. fillOrder printNewline.
+ ^ self
+ ].
+ (tagType == 269) ifTrue:[
+ "documentName"
+ 'documentName ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 270) ifTrue:[
+ "imageDescription"
+ 'imageDescription ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 271) ifTrue:[
+ "make"
+ 'make ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 272) ifTrue:[
+ "model"
+ 'model ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 273) ifTrue:[
+ "stripoffsets"
+ stripOffsets := valueArray.
+ 'stripOffsets Array(' print. stripOffsets size print. ')' printNewline.
+ ^ self
+ ].
+ (tagType == 274) ifTrue:[
+ "Orientation"
+ "orientation:= value."
+ 'orientation ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 277) ifTrue:[
+ "samplesPerPixel"
+ samplesPerPixel := value.
+ 'samplesperpixel ' print. samplesPerPixel printNewline.
+ ^ self
+ ].
+ (tagType == 278) ifTrue:[
+ "rowsperstrip"
+ rowsPerStrip := value.
+ 'rowsperstrip ' print. rowsPerStrip printNewline.
+ ^ self
+ ].
+ (tagType == 279) ifTrue:[
+ "stripbytecount"
+ stripByteCounts := valueArray.
+ 'stripByteCounts Array(' print.
+ stripByteCounts size print.
+ ')' printNewline.
+ ^ self
+ ].
+ (tagType == 280) ifTrue:[
+ "MinSampleValue"
+ "minSampleValue:= value."
+ 'minSampleValue ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 281) ifTrue:[
+ "MaxSampleValue"
+ "maxSampleValue:= value."
+ 'maxSampleValue ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 282) ifTrue:[
+ "xResolution"
+ 'xres ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 283) ifTrue:[
+ "yResolution"
+ 'yres ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 284) ifTrue:[
+ "planarconfig"
+ (value == 1) ifTrue:[
+ planarConfiguration := 1
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ planarConfiguration := 2
+ ] ifFalse:[
+ planarConfiguration := nil
+ ]
+ ].
+ 'planarconfig ' print. planarConfiguration printNewline.
+ ^ self
+ ].
+ (tagType == 285) ifTrue:[
+ "pageName"
+ 'pageName ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 286) ifTrue:[
+ "xPosition"
+ 'xPos ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 287) ifTrue:[
+ "yPosition"
+ 'yPos ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 288) ifTrue:[
+ "freeOffsets"
+ 'freeOffsets ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 289) ifTrue:[
+ "freeByteCounts"
+ 'freeByteCounts ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 290) ifTrue:[
+ "grayResponceUnit"
+ 'grayResponceUnit' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 291) ifTrue:[
+ "grayResponceCurve"
+ 'grayResponceCurve' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 292) ifTrue:[
+ "group3options"
+ group3options := value.
+ 'group3options ' print. group3options printNewline.
+ ^ self
+ ].
+ (tagType == 293) ifTrue:[
+ "group4options"
+ "group4options := value."
+ 'group4options ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 296) ifTrue:[
+ "resolutionunit"
+ (value == 1) ifTrue:[
+ 'res-unit pixel' printNewline
+ ] ifFalse:[
+ (value == 2) ifTrue:[
+ 'res-unit inch' printNewline
+ ] ifFalse:[
+ (value == 3) ifTrue:[
+ 'res-unit mm' printNewline
+ ] ifFalse:[
+ 'res-unit invalid' printNewline
+ ]
+ ]
+ ].
+ "resolutionUnit := value."
+ ^ self
+ ].
+ (tagType == 297) ifTrue:[
+ "pageNumber"
+ "pageNumber := value."
+ 'pageNumber ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 300) ifTrue:[
+ "colorResponceUnit"
+ 'colorResponceUnit' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 301) ifTrue:[
+ "colorResponceCurve"
+ 'colorResponceCurve' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 306) ifTrue:[
+ "dateTime"
+ 'dateTime ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 315) ifTrue:[
+ "artist"
+ 'artist ' print. value printNewline.
+ ^ self
+ ].
+ (tagType == 317) ifTrue:[
+ "predictor"
+ predictor := value.
+ 'predictor ' print. predictor printNewline.
+ ^ self
+ ].
+ (tagType == 320) ifTrue:[
+ "colorMap"
+ 'colorMap (size=' print. valueArray size print. ')' printNewline.
+ n := valueArray size // 3.
+ colorMap := Array new:3.
+ colorMap at:1 put:(valueArray copyFrom:1 to:n).
+ colorMap at:2 put:(valueArray copyFrom:n+1 to:2*n).
+ colorMap at:3 put:(valueArray copyFrom:2*n+1 to:3*n).
+ 1 to:3 do:[:c |
+ 1 to:n do:[:e |
+ val := (colorMap at:c) at:e.
+ val := (val * 255.0 / 16rFFFF) rounded.
+ (colorMap at:c) at:e put:val
+ ]
+ ].
+ ^ self
+ ].
+
+'tag:' print. tagType print. ' typ:' print. numberType print.
+' len:' print. length print. ' offs:' print. offset print.
+' val:' print. value print. ' valArr:' print. valueArray printNewline.
+
+ 'unknown type ' print. tagType printNewline
+!
+
+writeBits
+ "write bits as one strip"
+
+ |offs bytesPerRow|
+
+ data size < 16rFFFF ifTrue:[
+ stripOffsets := Array with:(outStream position - 1).
+ stripByteCounts := Array with:(data size).
+ outStream nextPutBytes:data size from:data.
+ rowsPerStrip := height
+ ] ifFalse:[
+ stripOffsets := Array new:height.
+ bytesPerRow := data size // height.
+ stripByteCounts := (Array new:height) atAllPut:bytesPerRow.
+
+ offs := 1.
+ 1 to:height do:[:row |
+ stripOffsets at:row put:(outStream position - 1).
+ outStream nextPutBytes:data size from:data startingAt:offs.
+ offs := offs + bytesPerRow
+ ].
+ rowsPerStrip := 1
+ ].
+ 'stripOffsets: ' print. stripOffsets printNewline.
+ 'stripByteCounts: ' print. stripByteCounts printNewline.
+!
+
+writeColorMap
+ colorMapPos := outStream position.
+ colorMap do:[:subMap |
+ subMap do:[:entry |
+ "my maps are 8 bit - tiff map is 16 bit"
+
+ self writeShort:(entry / 255 * 16rFFFF) rounded
+ ]
+ ]
+!
+
+writeStripOffsets
+'stripOffsets: ' print. stripOffsets printNewline.
+'store stripoffsets at: ' print. outStream position printNewline.
+ stripOffsetsPos := outStream position.
+ stripOffsets do:[:o |
+ self writeLong:o
+ ]
+!
+
+writeStripByteCounts
+'stripByteCounts: ' print. stripByteCounts printNewline.
+'store stripbytecounts at: ' print. outStream position printNewline.
+ stripByteCountsPos := outStream position.
+ stripByteCounts do:[:c |
+ self writeShort:c
+ ]
+!
+
+writeBitsPerSample
+'bitsPerSample: ' print. bitsPerSample printNewline.
+'store bitspersample at: ' print. outStream position printNewline.
+ bitsPerSamplePos := outStream position.
+ bitsPerSample do:[:n |
+ self writeShort:n
+ ]
+!
+
+writeTag:tagType
+ self writeTiffTag:tagType.
+!
+
+writeTiffTag:tagType
+ |value valueArray numberType count address|
+
+ count := 1.
+ address := nil.
+ (tagType == 253) ifTrue:[
+ "tiff class"
+ ].
+ (tagType == 254) ifTrue:[
+ ].
+ (tagType == 255) ifTrue:[
+ "SubfileType"
+ value := subFileType.
+ numberType := #long.
+ ].
+ (tagType == 256) ifTrue:[
+ "ImageWidth"
+ value := width.
+ numberType := #short.
+ ].
+ (tagType == 257) ifTrue:[
+ "ImageHeight"
+ value := height.
+ numberType := #short.
+ ].
+ (tagType == 258) ifTrue:[
+ "bitspersample"
+ address := bitsPerSamplePos - 1.
+ numberType := #short.
+ count := bitsPerSample size.
+ valueArray := bitsPerSample
+ ].
+ (tagType == 259) ifTrue:[
+ "compression"
+ value := compression.
+ numberType := #short.
+ ].
+ (tagType == 262) ifTrue:[
+ "photometric"
+ (photometric == #whiteIs0) ifTrue:[
+ value := 0
+ ] ifFalse:[
+ (photometric == #blackIs0) ifTrue:[
+ value := 1
+ ] ifFalse:[
+ (photometric == #rgb) ifTrue:[
+ value := 2
+ ] ifFalse:[
+ (photometric == #palette) ifTrue:[
+ value := 3
+ ] ifFalse:[
+ (photometric == #transparency) ifTrue:[
+ value := 4
+ ] ifFalse:[
+ self error:'bad photometric'
+ ]
+ ]
+ ]
+ ]
+ ].
+ numberType := #short.
+ ].
+ (tagType == 263) ifTrue:[
+ ].
+ (tagType == 264) ifTrue:[
+ ].
+ (tagType == 265) ifTrue:[
+ ].
+ (tagType == 266) ifTrue:[
+ "fillOrder"
+ (fillOrder == #msb) ifTrue:[
+ value := 1
+ ] ifFalse:[
+ (fillOrder == #lsb) ifTrue:[
+ value := 2
+ ] ifFalse:[
+ self error:'bad fillOrder'
+ ]
+ ].
+ numberType := #short.
+ ].
+ (tagType == 269) ifTrue:[
+ ].
+ (tagType == 270) ifTrue:[
+ ].
+ (tagType == 271) ifTrue:[
+ ].
+ (tagType == 272) ifTrue:[
+ ].
+ (tagType == 273) ifTrue:[
+ "stripoffsets"
+ address := stripOffsetsPos - 1.
+ numberType := #long.
+ count := stripOffsets size.
+ valueArray := stripOffsets
+ ].
+ (tagType == 274) ifTrue:[
+ ].
+ (tagType == 277) ifTrue:[
+ "samplesPerPixel"
+ value := samplesPerPixel.
+ numberType := #short.
+ ].
+ (tagType == 278) ifTrue:[
+ "rowsperstrip"
+ value := rowsPerStrip.
+ numberType := #short.
+ ].
+ (tagType == 279) ifTrue:[
+ "stripbytecount"
+ address := stripByteCountsPos - 1.
+ numberType := #short.
+ count := stripByteCounts size.
+ valueArray := stripByteCounts
+ ].
+ (tagType == 280) ifTrue:[
+ "min sample value"
+ ].
+ (tagType == 281) ifTrue:[
+ "max sample value"
+ ].
+ (tagType == 282) ifTrue:[
+ "x resolution"
+ ].
+ (tagType == 283) ifTrue:[
+ "y resolution"
+ ].
+ (tagType == 284) ifTrue:[
+ "planarconfig"
+ value := planarConfiguration.
+ numberType := #short.
+ ].
+ (tagType == 285) ifTrue:[
+ "pageName"
+ ].
+ (tagType == 286) ifTrue:[
+ "xPosition"
+ ].
+ (tagType == 287) ifTrue:[
+ "yPosition"
+ ].
+ (tagType == 288) ifTrue:[
+ "freeOffsets"
+ ].
+ (tagType == 289) ifTrue:[
+ "freeByteCounts"
+ ].
+ (tagType == 290) ifTrue:[
+ "grayResponceUnit"
+ ].
+ (tagType == 291) ifTrue:[
+ "grayResponceCurve"
+ ].
+ (tagType == 292) ifTrue:[
+ "group3options"
+ value := group3options.
+ numberType := #long.
+ ].
+ (tagType == 293) ifTrue:[
+ "group4options"
+ ].
+ (tagType == 296) ifTrue:[
+ "resolutionunit"
+ ^ self
+ ].
+ (tagType == 297) ifTrue:[
+ "pageNumber"
+ ].
+ (tagType == 300) ifTrue:[
+ "colorResponceUnit"
+ ].
+ (tagType == 301) ifTrue:[
+ "colorResponceCurve"
+ ].
+ (tagType == 306) ifTrue:[
+ "dateTime"
+ ].
+ (tagType == 315) ifTrue:[
+ "artist"
+ ].
+ (tagType == 317) ifTrue:[
+ "predictor"
+ ].
+ (tagType == 320) ifTrue:[
+ "colormap"
+ address := colorMapPos - 1.
+ numberType := #short.
+ count := (colorMap at:1) size * 3.
+ ].
+
+ (value isNil and:[address isNil]) ifTrue:[
+ self error:'unhandled tag'.
+ ^ self
+ ].
+
+'tag:' print. tagType print. ' typ:' print. numberType print.
+' len:' print. count print.
+' val:' print. value printNewline.
+
+ self writeShort:tagType.
+ numberType == #short ifTrue:[
+ self writeShort:3.
+ self writeLong:count.
+ ] ifFalse:[
+ numberType == #long ifTrue:[
+ self writeShort:4.
+ self writeLong:count.
+ ] ifFalse:[
+ numberType == #byte ifTrue:[
+ self writeShort:1.
+ self writeLong:count.
+ ] ifFalse:[
+ self error:'bad numbertype'
+ ]
+ ]
+ ].
+ address notNil ifTrue:[
+ (numberType == #long and:[count == 1]) ifTrue:[
+ self writeLong:(valueArray at:1).
+ ^ self
+ ].
+ (numberType == #short and:[count <= 2]) ifTrue:[
+ self writeShort:(valueArray at:1).
+ count == 2 ifTrue:[
+ self writeShort:(valueArray at:2).
+ ] ifFalse:[
+ self writeShort:0
+ ].
+ ^ self
+ ].
+ (numberType == #byte and:[count <= 4]) ifTrue:[
+ outStream nextPut:(valueArray at:1).
+ count > 1 ifTrue:[
+ outStream nextPut:(valueArray at:2).
+ count > 2 ifTrue:[
+ outStream nextPut:(valueArray at:3).
+ count > 3 ifTrue:[
+ outStream nextPut:(valueArray at:4).
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ] ifFalse:[
+ outStream nextPut:0
+ ].
+ ^ self
+ ].
+ self writeLong:address.
+ ^ self
+ ].
+ numberType == #short ifTrue:[
+ self writeShort:value.
+ self writeShort:0
+ ] ifFalse:[
+ numberType == #long ifTrue:[
+ self writeLong:value
+ ] ifFalse:[
+ numberType == #byte ifTrue:[
+ outStream nextPut:value.
+ outStream nextPut:0.
+ outStream nextPut:0.
+ outStream nextPut:0.
+ ] ifFalse:[
+ self error:'bad numbertype'
+ ]
+ ]
+ ].
+!
+
+readUncompressedTiffImageData
+ |bytesPerRow bitsPerRow nPlanes
+ stripNr "{ Class: SmallInteger }"
+ offset "{ Class: SmallInteger }"
+ row "{ Class: SmallInteger }"
+ bytesPerStrip "{ Class: SmallInteger }"
+ bitsPerPixel |
+
+ nPlanes := samplesPerPixel.
+
+ "only support 1-sample/pixel,
+ with alpha - if separate planes,
+ or rgb - if non separate planes and no alpha"
+
+ (nPlanes == 2) ifTrue:[
+ (planarConfiguration ~~ 2) ifTrue:[
+ self error:'with alpha, only separate planes supported'.
+ ^ nil
+ ].
+ 'ignoring alpha plane' printNewline.
+ nPlanes := 1.
+ bitsPerPixel := bitsPerSample at:1
+ ] ifFalse:[
+ (nPlanes == 3) ifTrue:[
+ (planarConfiguration ~~ 1) ifTrue:[
+ self error:'only non separate planes supported'.
+ ^ nil
+ ].
+ bitsPerSample ~= #(8 8 8) ifTrue:[
+ self error:'only 8/8/8 rgb images supported'.
+ ^ nil
+ ].
+ bitsPerPixel := 24
+ ] ifFalse:[
+ (nPlanes ~~ 1) ifTrue:[
+ self error:'format not supported'.
+ ^ nil
+ ].
+ bitsPerPixel := bitsPerSample at:1
+ ]
+ ].
+
+ bitsPerRow := width * bitsPerPixel.
+ bytesPerRow := bitsPerRow // 8.
+ ((bitsPerRow \\ 8) ~~ 0) ifTrue:[
+ bytesPerRow := bytesPerRow + 1
+ ].
+
+ data := ByteArray uninitializedNew:(bytesPerRow * height).
+
+ offset := 1.
+ stripNr := 0.
+
+ row := 1.
+ bytesPerStrip := bytesPerRow * rowsPerStrip.
+ [row <= height] whileTrue:[
+ stripNr := stripNr + 1.
+ inStream position:((stripOffsets at:stripNr) + 1).
+
+ inStream nextBytes:(bytesPerRow * rowsPerStrip)
+ into:data
+ startingAt:offset.
+
+ offset := offset + bytesPerStrip.
+ row := row + rowsPerStrip
+ ]
+!
+
+readLZWTiffImageData
+ "read LZW compressed tiff data; this method only
+ handles 3x8 rgb and 1x2 or 2x2 greyscale images.
+ For 2x2 greyscale images, the alpha plane is ignored.
+ (maybe other formats work also - its simply not
+ tested)"
+
+ |bytesPerRow compressedStrip nPlanes
+ bytesPerStrip "{ Class: SmallInteger }"
+ nBytes "{ Class: SmallInteger }"
+ prevSize "{ Class: SmallInteger }"
+ stripNr "{ Class: SmallInteger }"
+ offset "{ Class: SmallInteger }"
+ row "{ Class: SmallInteger }" |
+
+ nPlanes := samplesPerPixel.
+
+ (nPlanes == 3) ifTrue:[
+ ((bitsPerSample at:1) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ ((bitsPerSample at:2) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ ((bitsPerSample at:3) ~~ 8) ifTrue:[
+ self error:'only 8 bit/sample supported'.
+ ^ nil
+ ].
+ bytesPerRow := width * samplesPerPixel.
+ ] ifFalse:[
+ (nPlanes == 2) ifTrue:[
+ (planarConfiguration ~~ 2) ifTrue:[
+ self error:'only separate planes supported'.
+ ^ nil
+ ].
+ 'ignoring alpha plane' printNewline.
+ nPlanes := 1
+ ].
+ (nPlanes == 1) ifFalse:[
+ self error:'only 3-sample rgb / monochrome supported'.
+ ^ nil
+ ].
+ bytesPerRow := (width * (bitsPerSample at:1) + 7) // 8.
+ ].
+
+ stripByteCounts isNil ifTrue:[
+ self error:'currently require stripByteCounts'.
+ ^ nil
+ ].
+
+ data := ByteArray uninitializedNew:(bytesPerRow * height).
+
+ offset := 1.
+ stripNr := 0.
+
+ row := 1.
+ bytesPerStrip := bytesPerRow * rowsPerStrip.
+ prevSize := 0.
+ [row <= height] whileTrue:[
+ stripNr := stripNr + 1.
+ inStream position:((stripOffsets at:stripNr) + 1).
+ nBytes := stripByteCounts at:stripNr.
+ (nBytes > prevSize) ifTrue:[
+ compressedStrip := ByteArray uninitializedNew:nBytes.
+ prevSize := nBytes
+ ].
+ inStream nextBytes:nBytes
+ into:compressedStrip.
+ self class decompressLZWFrom:compressedStrip
+ count:nBytes
+ into:data
+ startingAt:offset.
+ offset := offset + bytesPerStrip.
+ row := row + rowsPerStrip
+ ].
+
+ (predictor == 2) ifTrue:[
+ self class decodeDelta:3 in:data width:width height:height
+ ]
+!
+
+readCCITTGroup3TiffImageData
+ "not really tested - all I got is a single
+ fax from NeXT step"
+
+ |bytesPerRow bitsPerRow compressedStrip nPlanes
+ stripNr "{ Class: SmallInteger }"
+ offset "{ Class: SmallInteger }"
+ row "{ Class: SmallInteger }"
+ bytesPerStrip "{ Class: SmallInteger }" |
+
+ nPlanes := samplesPerPixel.
+ (nPlanes == 2) ifTrue:[
+ 'ignoring alpha plane' printNewline.
+ nPlanes := 1
+ ].
+
+ (nPlanes ~~ 1) ifTrue:[
+ self error:'only monochrome/greyscale supported'.
+ ^ nil
+ ].
+
+ stripByteCounts isNil ifTrue:[
+ self error:'currently require stripByteCounts'.
+ ^ nil
+ ].
+ (rowsPerStrip ~~ 1) isNil ifTrue:[
+ self error:'currently require rowsPerStrip to be 1'.
+ ^ nil
+ ].
+
+
+ bitsPerRow := width * (bitsPerSample at:1).
+ bytesPerRow := bitsPerRow // 8.
+ ((bitsPerRow \\ 8) ~~ 0) ifTrue:[
+ bytesPerRow := bytesPerRow + 1
+ ].
+
+ data := ByteArray uninitializedNew:(bytesPerRow * height).
+ compressedStrip := ByteArray uninitializedNew:bytesPerRow.
+
+ offset := 1.
+ stripNr := 0.
+
+ row := 1.
+ bytesPerStrip := bytesPerRow * rowsPerStrip.
+ [row <= height] whileTrue:[
+ stripNr := stripNr + 1.
+ inStream position:((stripOffsets at:stripNr) + 1).
+ inStream nextBytes:(stripByteCounts at:stripNr)
+ into:compressedStrip.
+ self class decompressCCITT3From:compressedStrip
+ into:data
+ startingAt:offset
+ count:width.
+ offset := offset + bytesPerStrip.
+ row := row + rowsPerStrip
+ ]
+!
+
+readJPEGTiffImageData
+ 'jpeg compression not implemented' printNewline
+!
+
+readPackbitsTiffImageData
+ "had no samples yet - however, packbits decompression
+ is rather trivial to add ..."
+
+ 'packbits compression not implemented' printNewline
+! !