"
 COPYRIGHT (c) 1991 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-Images support'
!

!TIFFReader class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1991 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.
"
!

version
"
$Header: /cvs/stx/stx/libview2/TIFFReader.st,v 1.24 1995-10-25 10:16:18 cg Exp $
"
!

documentation
"
    This class knows how to read TIFF files and how to
    write uncompressed TIFF files.

    Only single image files are supported.
    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 reading of uncompressed, LZW and G3 compressed 
    images; JPEG and packbits are currently not implemented.

    Only writing of uncompressed images is currently implemented.
    More formats will come ...

    TODO: since I dont want to spend all of my life adding more formats here and
    reinventing the wheel, this code should be changed to use the tiff library.
    That would give us most formats and also writing capabilities for free.
"
! !

!TIFFReader class methodsFor:'initialization'!

initialize
    Image fileFormats at:'.tiff' put:self.
    Image fileFormats at:'.tif'  put:self.
    Image fileFormats at:'.TIF'  put:self.
! !

!TIFFReader class methodsFor:'testing'!

isValidImageFile:aFileName
    "return true, if aFileName contains a GIF image"

    |inStream char1 char2 version|

    inStream := self streamReadingFile:aFileName.
    inStream isNil ifTrue:[^ false].

    char1 := inStream next.
    char2 := inStream next.

    ((char1 ~~ char2) or:[(char1 ~~ $I) and:[char1 ~~ $M]]) ifTrue:[
	inStream close.
	^ false
    ].

    inStream binary.
    version := inStream nextShortMSB:(char1 == $M).
    inStream close.

    (version ~~ 42) ifTrue:[^ false].
    ^ true
!

canRepresent:anImage
    "return true, if anImage can be represented in my file format.
     Any image is supported."

    ^ true
! !

!TIFFReader methodsFor:'reading from file'!

fromStream:aStream
    "read an image from aStream"

    |char1 char2 version 
     numberOfTags "{ Class: SmallInteger }"
     tagType      "{ Class: SmallInteger }"
     numberType   "{ Class: SmallInteger }"
     length       "{ Class: SmallInteger }"
     result offset ok msb|

    inStream := aStream.

    char1 := aStream next.
    char2 := aStream next.
    (char1 ~~ char2) ifTrue:[
	'TIFFReader: not a tiff file' errorPrintNL.
	^ nil
    ].
    (char1 == $I) ifTrue:[
	byteOrder := #lsb.
	msb := false.
    ] ifFalse:[
	(char1 == $M) ifTrue:[
	    byteOrder := #msb.
	    msb := true.
	] ifFalse:[
	    'TIFFReader: not a tiff file' errorPrintNL.
	    ^ nil
	]
    ].

    aStream binary.

    version := self readShort.
    (version ~~ 42) ifTrue:[
	'TIFFReader: version of tiff-file not supported' errorPrintNL.
	^ 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 := aStream nextLongMSB:msb.
    aStream position:offset + 1.

    numberOfTags := self readShort.
    1 to:numberOfTags do:[:index |
	tagType := self readShort.
	numberType := self readShort.
	length := aStream nextLongMSB:msb.
	self decodeTiffTag:tagType numberType:numberType length:length
    ].

    offset := aStream nextLongMSB:msb.
    (offset ~~ 0) ifTrue:[
	'TIFFReader: more tags ignored' errorPrintNL
    ].

    "check for required tags"
    ok := true.
    width isNil ifTrue:[
	'TIFFReader: missing width tag' errorPrintNL.
	ok := false
    ].

    height isNil ifTrue:[
	'TIFFReader: missing length tag' errorPrintNL.
	ok := false
    ].

    photometric isNil ifTrue:[
	'TIFFReader: missing photometric tag' errorPrintNL.
	ok := false
    ].

    stripOffsets isNil ifTrue:[
	'TIFFReader: missing stripOffsets tag' errorPrintNL.
	ok := false
    ].

    ok ifFalse:[
	^ nil
    ].

    "given all the information, read the bits"

    rowsPerStrip isNil ifTrue:[
	rowsPerStrip := height
    ].

    ok := false.
    (compression == 1) ifTrue:[
	result := self readUncompressedTiffImageData.
	ok := true
    ].
    (compression == 2) ifTrue:[
	result := self readCCITT3RLETiffImageData.
	ok := true
    ].
    (compression == 3) ifTrue:[
	result := self readCCITTGroup3TiffImageData.
	ok := true
    ]. 
    (compression == 4) ifTrue:[
	result := self readCCITTGroup4TiffImageData.
	ok := true
    ]. 
    (compression == 5) ifTrue:[
	result := self readLZWTiffImageData.
	ok := true
    ].
    (compression == 6) ifTrue:[
	result := self readJPEGTiffImageData.
	ok := true
    ].
    (compression == 32766) ifTrue:[
	result := self readNeXTRLE2TiffImageData.
	ok := true
    ].
    (compression == 32771) ifTrue:[
	result := self readCCITTRLEWTiffImageData.
	ok := true
    ].
    (compression == 32773) ifTrue:[
	result := self readPackbitsTiffImageData.
	ok := true
    ].
    (compression == 32865) ifTrue:[
	result := self readNeXTJPEGTiffImageData.
	ok := true
    ].
    ok ifFalse:[
	'TIFFReader: compression type ' errorPrint. compression errorPrint.
	' not known' errorPrintNL
    ].
    ^ result
! !

!TIFFReader methodsFor:'writing to file'!

save:image onFile:aFileName
    "save image as (uncompressed) TIFF file on aFileName"

    |pos1 pos|

    outStream := FileStream newFileNamed:aFileName.
    outStream isNil ifTrue:[
	'TIFFReader: create error' errorPrintNL. 
	^ nil
    ].

    "save as msb"

    byteOrder := #msb.
"
    byteOrder := #lsb.
"
    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.

    currentOffset := 0.

    (byteOrder == #msb) ifTrue:[
	outStream nextPut:$M.
	outStream nextPut:$M.
    ] ifFalse:[
	outStream nextPut:$I.
	outStream nextPut:$I.
    ].
    currentOffset := currentOffset + 2.

    outStream binary.

    self writeShort:42.
    currentOffset := currentOffset + 2.

    pos1 := outStream position.
    self writeLong:0.           "start of tags - filled in later"
    currentOffset := currentOffset + 4.

    "output strips"

    self writeUncompressedBits. "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).                   "fill in tag offset"
    outStream position:pos.
"
('patch tag offset at: ', (pos1 printStringRadix:16) , ' to ',
			 (pos printStringRadix:16)) printNewline.
"
    "output tag data"

    photometric == #palette ifTrue:[
	self writeShort:10.  "10 tags"
    ] ifFalse:[
	self writeShort:9.   "9 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:278.               "rowsPerStrip"
    self writeTag:279.               "strip byte counts"
    self writeTag:284.               "planarconfig"
    photometric == #palette ifTrue:[
	self writeTag:320            "colorMap"
    ].
    self writeLong:0.                "end of tags mark"
    outStream close
! !

!TIFFReader methodsFor:'private'!

readLongs:nLongs
    "read nLongs long numbers (32bit) and return them in an array"

    |oldPos offset values msb 
     n "{ Class: SmallInteger }" |

    n := nLongs.

    msb := byteOrder ~~ #lsb.
    values := Array basicNew:n.
    (n == 1) ifTrue:[
	values at:1 put:(inStream nextLongMSB:msb).
    ] ifFalse:[
	offset := inStream nextLongMSB:msb.
	oldPos := inStream position.
	inStream position:(offset + 1).
	1 to:n do:[:index |
	    values at:index put:(inStream nextLongMSB:msb)
	].
	inStream position:oldPos
    ].
    ^ values
!

readShorts:nShorts
    "read nShorts short numbers (16bit) and return them in an array"

    |oldPos offset values msb val2
     n "{ Class: SmallInteger }" |

    n := nShorts.

    msb := (byteOrder ~~ #lsb).
    values := Array basicNew:n.
    (n <= 2) ifTrue:[
	values at:1 put:(inStream nextUnsignedShortMSB:msb).
	val2 := inStream nextUnsignedShortMSB:msb.

	(n == 2) ifTrue:[
	    values at:2 put:val2
	]
    ] ifFalse:[
	offset := inStream nextLongMSB:msb.
	oldPos := inStream position.
	inStream position:(offset + 1).
	1 to:n do:[:index |
	    values at:index put:(inStream nextUnsignedShortMSB:msb)
	].
	inStream position:oldPos
    ].
    ^ values
!

readChars:n
    "read n characters and return them in a string"

    |oldPos offset string|

    string := String new:(n - 1).
    (n <= 4) ifTrue:[
	inStream nextBytes:(n - 1) into:string
    ] ifFalse:[
	offset := inStream nextLongMSB:(byteOrder ~~ #lsb).
	oldPos := inStream position.
	inStream position:(offset + 1).
	inStream nextBytes:(n - 1) into:string.
	inStream position:oldPos
    ].
    ^ string
!

readFracts:nFracts
    "read nFracts fractions (2 32bit words) and return them in an array"

    |oldPos offset values numerator denominator msb
     n "{ Class: SmallInteger }" |

    n := nFracts.

    msb := byteOrder ~~ #lsb.
    values := Array basicNew:n.
    offset := inStream nextLongMSB:msb.
    oldPos := inStream position.
    inStream position:(offset + 1).
    1 to:n do:[:index |
	numerator := inStream nextLongMSB:msb.
	denominator := inStream nextLongMSB:msb.
	values at:index put:(Fraction numerator:numerator denominator:denominator)
    ].
    inStream position:oldPos.
    ^ values
!

decodeTiffTag:tagType numberType:numberType length:length
    |offset value valueArray 
     val scaleFactor rV gV bV
     n  "{ Class: SmallInteger }"
     i2 "{ Class: SmallInteger }"
     i3 "{ 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 := (inStream nextLongMSB:(byteOrder ~~ #lsb))
		]
	    ]
	]
    ].

    (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:[
		  (value == 5) ifTrue:[
		    photometric := #separated  "/ color separations
		  ] ifFalse:[
		    (value == 6) ifTrue:[
		      photometric := #ycbr    "/ CCIR 601
		    ] ifFalse:[
		      (value == 8) ifTrue:[
			photometric := #cielab  "/ 1976 CIE L*a*b*
		      ] 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 - info only"
"
	'documentName ' print. value printNewline.
"
	^ self
    ].
    (tagType == 270) ifTrue:[
	"imageDescription - info only"
"
	'imageDescription ' print. value printNewline.
"
	^ self
    ].
    (tagType == 271) ifTrue:[
	"make - info only"
"
	'make ' print. value printNewline.
"
	^ self
    ].
    (tagType == 272) ifTrue:[
	"model - info only"
"
	'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 == 305) ifTrue:[
	"software - info only"
"
	'software' print. value printNewline.
"
	^ self
    ].
    (tagType == 306) ifTrue:[
	"dateTime - info only"
"
	'dateTime ' print. value printNewline.
"
	^ self
    ].
    (tagType == 315) ifTrue:[
	"artist - info only"
"
	'artist ' print. value printNewline.
"
	^ self
    ].
    (tagType == 316) ifTrue:[
	"host computer - info only"
"
	'host ' print. value printNewline.
"
	^ self
    ].
    (tagType == 317) ifTrue:[
	"predictor"
	predictor := value.
"
	'predictor ' print. predictor printNewline.
"
	^ self
    ].
    (tagType == 318) ifTrue:[
	"whitePoint"
"
	'whitePoint ' print. value printNewline.
"
	^ self
    ].
    (tagType == 319) ifTrue:[
	"primaryChromatics"
"
	'primaryChromatics ' print. value printNewline.
"
	^ self
    ].
    (tagType == 320) ifTrue:[
	"colorMap"
"
	'colorMap (size=' print. valueArray size print. ')' printNewline.
"
	"
	 the tiff colormap contains 16bit values;
	 our colormap expects 8bit values
	"
	n := valueArray size // 3.

	rV := ByteArray uninitializedNew:n.
	gV := ByteArray uninitializedNew:n.
	bV := ByteArray uninitializedNew:n.
	scaleFactor := 255.0 / 16rFFFF.
	i2 := n+1.
	i3 := 2*n+1.
	1 to:n do:[:vi |
	    val := ((valueArray at:vi) * scaleFactor) rounded.
	    rV at:vi put:val.
	    val := ((valueArray at:i2) * scaleFactor) rounded.
	    gV at:vi put:val.
	    val := ((valueArray at:i3) * scaleFactor) rounded.
	    bV at:vi put:val.
	    i2 := i2 + 1.
	    i3 := i3 + 1.
	].
	colorMap := Colormap redVector:rV greenVector:gV blueVector:bV.
	^ self
    ].
    (tagType == 332) ifTrue:[
	"ink set"
"
	'ink set' print. value printNewline.
"
	^ self
    ].
    (tagType == 333) ifTrue:[
	"ink names"
"
	'ink names' print. value printNewline.
"
	^ self
    ].
    (tagType == 336) ifTrue:[
	"dot range"
"
	'dot range' print. value printNewline.
"
	^ self
    ].
    (tagType == 337) ifTrue:[
	"target printer"
"
	'target printer' print. value printNewline.
"
	^ self
    ].
    (tagType == 339) ifTrue:[
	"sample format"
"
	'sample format' print. value printNewline.
"
	^ self
    ].
    (tagType == 340) ifTrue:[
	"min sample value"
"
	'min sample value' print. value printNewline.
"
	^ self
    ].
    (tagType == 341) ifTrue:[
	"max sample value"
"
	'max sample value' print. value printNewline.
"
	^ self
    ].
    (tagType == 512) ifTrue:[
	"jpeg proc"
"
	'jpeg proc' print. value printNewline.
"
	^ self
    ].
    (tagType == 513) ifTrue:[
	"jpeg proc"
"
	'jpeg proc' print. value printNewline.
"
	^ self
    ].
    (tagType == 32995) ifTrue:[
	"matteing"
"
	'matteing' print. value printNewline.
"
	^ self
    ].
    (tagType == 32996) ifTrue:[
	"datatype"
"
	'datatype' print. value printNewline.
"
	^ self
    ].
    (tagType == 32997) ifTrue:[
	"imagedepth"
"
	'imagedepth' print. value printNewline.
"
	^ self
    ].
    (tagType == 32998) ifTrue:[
	"tiledepth"
"
	'tiledepth' print. value printNewline.
"
	^ self
    ].

"
'TIFFReader: tag:' print. tagType print. ' typ:' print. numberType print.
' len:' print. length print. ' offs:' print. offset print. 
' val:' print. value print. ' valArr:' print. valueArray printNewline.  
"
    'TIFFReader: unknown tag type ' errorPrint. tagType errorPrintNL
!

writeUncompressedBits
    "write bits as one or multiple strips"

    |offs bytesPerRow nBytes
     h "{ Class: SmallInteger }"|

    nBytes := data size.
    nBytes < 16rFFFF ifTrue:[
	stripOffsets := Array with:(outStream position - 1).
	stripByteCounts := Array with:nBytes.
	outStream nextPutBytes:nBytes from:data.
	rowsPerStrip := height
    ] ifFalse:[
	stripOffsets := Array basicNew:height.
	bytesPerRow := nBytes // height.
	stripByteCounts := (Array basicNew:height) atAllPut:bytesPerRow.

	offs := 1.
	h := height.
	1 to:h do:[:row |
	    stripOffsets at:row put:(outStream position - 1).
	    outStream nextPutBytes:bytesPerRow from:data startingAt:offs.
	    offs := offs + bytesPerRow
	].
	rowsPerStrip := 1
    ].
"
    'stripOffsets: ' print. stripOffsets printNewline.
    'stripByteCounts: ' print. stripByteCounts printNewline.
"
!

writeColorMap
    |n|

    colorMapPos := outStream position.
    #(red green blue) do:[:component |
	n := 0.
	colorMap do:[:clr |
	    |entry|

	    clr isNil ifTrue:[
		entry := 0
	    ] ifFalse:[
		entry := clr perform:component.
		"
		 tiff map is 16 bit - scale from percent to 0..16rFFFF
		"
		entry := (entry * 16rFFFF / 100) rounded.
	    ].
	    self writeShort:entry.
	    n := n + 1
	].
	"
	 fill to 256 entries
	"
	[n < 256] whileTrue:[
	    self writeShort:0.
	    n := n + 1.
	]
    ]
!

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 := 256 "(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 }" 
     nBytes        "{ Class: SmallInteger }"
     bitsPerPixel overAllBytes|

    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
	].
	'TIFFReader: ignoring alpha plane' errorPrintNL.
	nPlanes := 1.
	bitsPerPixel := bitsPerSample at:1.
	bitsPerSample := Array with:bitsPerPixel.
	samplesPerPixel := 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
    ].

    overAllBytes := bytesPerRow * height.
    data := ByteArray uninitializedNew:overAllBytes.

    offset := 1.
    stripNr := 0.

    row := 1.
    [row <= height] whileTrue:[
	stripNr := stripNr + 1.
	nBytes := stripByteCounts at:stripNr.
	inStream position:((stripOffsets at:stripNr) + 1).

	inStream nextBytes:nBytes into:data startingAt:offset.
	offset := offset + nBytes.
	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
	    ].
	    'TIFFReader: ignoring alpha plane' errorPrintNL.
	    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
    ].

    'TIFFReader: decompressing LZW ...' infoPrintNL.

    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:[
	'TIFFReader: ignoring alpha plane' errorPrintNL.
	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
    ].

    'TIFFReader: decompressing CCITT-3 ...' infoPrintNL.

    bitsPerRow := width * (bitsPerSample at:1).
    bytesPerRow := bitsPerRow // 8.
    ((bitsPerRow \\ 8) ~~ 0) ifTrue:[
	bytesPerRow := bytesPerRow + 1
    ].

    data := ByteArray new:(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
    'TIFFReader: jpeg compression not implemented' errorPrintNL
!

readNeXTJPEGTiffImageData
    'TIFFReader: jpeg compression not implemented' errorPrintNL
!

readCCITT3RLETiffImageData
     'TIFFReader: ccitt mod Huffman (rle) compression not implemented' errorPrintNL.
!

readCCITT3RLEWTiffImageData
     'TIFFReader: ccitt mod Huffman (rlew) compression not implemented' errorPrintNL.
!

readCCITTGroup4TiffImageData
    'TIFFReader: ccitt group4 fax compression not implemented' errorPrintNL.
!

readNeXTRLE2TiffImageData
    'TIFFReader: next 2bit rle compression not implemented' errorPrintNL.
!

readPackbitsTiffImageData
    "had no samples yet - however, packbits decompression
     is rather trivial to add ..."

    'TIFFReader: packbits compression not implemented' errorPrintNL
! !