"

 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 comment:'

COPYRIGHT (c) 1991 by Claus Gittinger

	      All Rights Reserved

'!

!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

"

"

!

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:[