Hi Folks,

In Mac OS X 10.5, retrieving graphics from the clipboard usually 
requires TIFF decoding. Googling a bit, I found 
http://article.gmane.org/gmane.comp.lang.smalltalk.squeak.general/80994 
. It is a basic TIFF reader by Martin McClure. I enhaned it, with RGB24 
and LZW support. TIFF encoding is not supported, but not hard to do if 
needed.

I could not contact Martin to get his permission to republish his code, 
but he already did so, and he also signed the MIT license agreement with 
VPRI. So it is ok to say that this code is under MIT.

Enjoy!

Cheers,
Juan Vuletich
-------------- next part --------------
'From Cuis 2.9 of 5 November 2010 [latest update: #634] on 13 January 2011 at 10:16 am'!
"Change Set:		TIFFReader 1.0
Date:			7 August 2001
Author:			Martin McClure

Adds the ability to read TIFFs. 
Features of version 1.0:
* Integrated with ImageReadWriter and FileList
* Reads uncompressed 24-bit RGB TIFF files with 8-bit alpha channels
  into 32-bit Forms, with the alpha channel intact.
* Reads both big-endian and little-endian TIFF files
Later added by jmv:
* Reading TIFFs without alpha channels
* Reading compressed TIFFS (LZW only)

Some features not yet implemented that would be reasonable:
* Writing TIFFs
* Reading TIFFS of different bit depths
* Any of the many other TIFF features

For more information, the code trail starts with TIFFReadWriter. If you have a comment or a question not answered by the code comments, send it to martin at hand2mouse.com

(RGB24 support without alpha channel and LZW decompression added by jmv)"!

!classDefinition: #TIFFField category: #'Graphics-Files-TIFF'!
Object subclass: #TIFFField
	instanceVariableNames: 'tag type values'
	classVariableNames: 'DefaultFields SingleValuedTagSymbols TagSymbols ValueReaderSelectors'
	poolDictionaries: ''
	category: 'Graphics-Files-TIFF'!

!TIFFField commentStamp: 'mrm 7/28/2001 15:55' prior: 0!
I represent a TIFF field, or tag-value pair. I'm part of a TIFFImageFileDirectory.
By Martin McClure

Structure:
 tag			Integer -- one of my tag constants that is the integer TIFF tag indicating the field meaning.
 type		Integer -- one of my type constants that is the integer TIFF type of my values
 values		Array -- my array of values. The size of size is equal to the TIFF 'count' word.
					Each value should be of a type compatible with my 'type' ivar.

ValueReaderSelectors 		Dictionary -- maps TIFF type integers to the selectors of the methods used to read field values of that type.

TagSymbols					Dictionary -- maps TIFF tag integers to tag symbols.

SingleValuedTagSymbols		Set -- contains the tag symbols of the fields types that should have a value that consists of an array of length one.

DefaultFields				Dictionary -- maps tag symbols to the default field with that tag. Only maps tag symbols for which the TIFF spec defines a default.!

!classDefinition: #TIFFImageFileDirectory category: #'Graphics-Files-TIFF'!
Object subclass: #TIFFImageFileDirectory
	instanceVariableNames: 'fields'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Files-TIFF'!

!TIFFImageFileDirectory commentStamp: 'mrm 7/28/2001 13:12' prior: 0!
Mirrors the structure of a TIFF file's Image File Directory. Can be created by parsing itself from a TIFFStream or can (future) write itself to a TIFFStream.
By Martin McClure

Structure:
 fields		Dictionary -- maps tag symbols to the TIFFFields that make up this IFD.
 
See TIFFStructure for more information about where I fit.!

!classDefinition: #TIFFReadWriter category: #'Graphics-Files'!
ImageReadWriter subclass: #TIFFReadWriter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Files'!

!TIFFReadWriter commentStamp: 'mrm 7/27/2001 21:56' prior: 0!
For translating Forms to and from the TIFF file format. 
By Martin McClure

This work is based on TIFF revision 6.0. I got the specification from:
http://partners.adobe.com/asn/developer/PDFS/TN/TIFF6.pdf
The spec itself claims it can be obtained from:
http://www.adobe.com/Support/TechNotes.html
and from:
ftp://ftp.adobe.com/pub/adobe/DeveloperSupport/TechNotes/PDFfiles


Structure:
 stream			TIFFStream -- defined by superclass, wraps the stream that
							is being read or written

Current features:
* Reads uncompressed 24-bit RGB TIFF files with 8-bit alpha channels
  into 32-bit Forms, with the alpha channel intact.
* Reads both big-endian and little-endian TIFF files
* Reading TIFFs without alpha channels
* Reading compressed TIFFS (LZW only)

Some features not yet implemented that would be reasonable for this class:
* Writing TIFFs
* Reading TIFFS of different bit depths
* Any of the many other TIFF features

I've tried to make it reasonably easy for anyone who wants to add more of the missing features by breaking the design down into simple little chunks. The chief components are TIFFStream, which wraps a PositionableStream and translates the endian-ness of the stream, TIFFStructure and all its associated classes, which mirror the logical structure of the TIFF file, and TIFFReader (and future TIFFWriter) which interprets the structure of a TIFF and generates the appropriate Form.!

!classDefinition: #TIFFReader category: #'Graphics-Files-TIFF'!
Object subclass: #TIFFReader
	instanceVariableNames: 'stream structure'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Files-TIFF'!

!TIFFReader commentStamp: 'mrm 7/27/2001 22:05' prior: 0!
I parse a TIFF file and produce a Form. I usually am created and used by a TIFFReadWriter.
By Martin McClure

Structure:
 stream		TIFFStream -- Usually over a TIFF file.
 structure		TIFFStructure -- The TIFF IFDs and fields that together make up the image characteristics, all the information but the pixels themselves.

!

!classDefinition: #TIFFStream category: #'Graphics-Files-TIFF'!
Object subclass: #TIFFStream
	instanceVariableNames: 'stream bigEndian compressionType remainBitCount outCodes maxOutCodes outCount prefixTable suffixTable bitMask clearCode eoiCode freeCode codeSize maxCode finChar oldCode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Files-TIFF'!

!TIFFStream commentStamp: '<historical>' prior: 0!
Wraps a PositionableStream. Allows access to TIFF simple multi-byte types, remembering whether this TIFF is big-endian or little-endian.
By Martin McClure

Structure:
 stream				PositionableStream -- my underlying stream
 bigEndian			Boolean -- false if little-endian, true if big-endian
 compressionType	Integer -- currently supported: 1: no compression, 5 LZW compression

Only implements enough Stream protocol to let TIFFReadWriter and its cohorts to do their job.!

!classDefinition: #TIFFStructure category: #'Graphics-Files-TIFF'!
Object subclass: #TIFFStructure
	instanceVariableNames: 'imageFileDirectories'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Graphics-Files-TIFF'!

!TIFFStructure commentStamp: 'mrm 7/27/2001 21:42' prior: 0!
I mirror the logical structure of a TIFF file, including its directories and fields but not its pixel data. I can parse a TIFFStream or (future) write to a TIFFStream. I'm not too smart about what my structure means, I leave that interpretation to TIFFImage.
By Martin McClure

Structure:
 imageFileDirectories		SequenceableCollection -- each element is a TIFFImageFileDirectory

I hold the logical structure of the TIFF, but I do not preserve the physical structure (specific offsets) of the file I was parsed from (except for the offsets of the pixel data.)

See TIFFReader (and future TIFFWriter) for more information about the structure into which I fit.!


!TIFFField methodsFor: 'private' stamp: 'mrm 7/28/2001 13:47'!
isSingleValued
	"Answer true iff my tag is one that should only have one value, and I only have one value.
	Raise an error if I should have exactly one value but I have some other number of values."
	| singleValued |
	singleValued _ SingleValuedTagSymbols includes: self tagSymbol.
	(singleValued and: [values size ~= 1])
		ifTrue: [self error: 'Field not single-valued that should be.'].
	^ singleValued.! !

!TIFFField methodsFor: 'private' stamp: 'mrm 8/6/2001 21:08'!
parseFrom: aTIFFStream
	"Fill in my state with the results from parsing the given TIFFStream from its current position. Leave the stream positioned after the field, which will be the beginning of the next field, if any. Answer nil if the field has an unknown tag, otherwise answer self."

	| selector |
	tag _ aTIFFStream nextShort.
	(TagSymbols includesKey: tag) 
		ifFalse: [aTIFFStream skip: 10. "Move past the type, count, and value/offset."
				^ nil].
	type _ aTIFFStream nextShort.
	selector _ ValueReaderSelectors 
		at: type 
		ifAbsent: "Can't read this type, ignore the field."
			[aTIFFStream skip: 8. "Move past the value/offset."
			^ nil].
	self perform: selector with: aTIFFStream.
	! !

!TIFFField methodsFor: 'private' stamp: 'mrm 7/28/2001 16:27'!
tag: tagInteger type: typeInteger values: valueArray
	"Set my state to the given values."
	tag _ tagInteger.
	type _ typeInteger.
	values _ valueArray.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 17:34'!
read: count charsFrom: aTIFFStream
	"Read count bytes from the current position of aTIFFStream and return them as an Array of Strings, using NUL as the separating character between strings. Don't worry about the ending position of aTIFFStream."
	| strings oneString size |
	strings _ OrderedCollection new.
	oneString _ OrderedCollection new.
	(1 to: count) do: 
		[:i | (aTIFFStream peek = 0)
			ifFalse: [oneString add: aTIFFStream nextByte.]
			ifTrue: "Null, so that's the end of this string. "
				[size _ oneString size.
				strings add: ((String new: size) replaceFrom: 1 to: size with: oneString).].].
	^ strings asArray.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:56'!
readAsciiValuesFrom: aTIFFStream
	"Read the count long and count number of characters from aTIFFStream at its current position according to my type. Store the result as one or more Strings in my array of values, using the NUL character to detect separation between strings. Leave aTIFFStream positioned eight bytes past its starting position."

	| count |
	count _ aTIFFStream nextLong.
	values _ (count <= 4) "Offset is immediate data, not pointer to data."
		ifTrue: [self readImmediate: count charsFrom: aTIFFStream.]
		ifFalse: [self readIndirect: count charsFrom: aTIFFStream.].! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:35'!
readByteValuesFrom: aTIFFStream
	"Read the count long and count number of bytes from aTIFFStream at its current position according to my type. Store the result as my array of values. Leave aTIFFStream positioned eight bytes past its starting position."

	| count |
	count _ aTIFFStream nextLong.
	values _ Array new: count.
	(count <= 4) "Offset is immediate data, not pointer to data."
		ifTrue: [self readImmediate: count bytesFrom: aTIFFStream.]
		ifFalse: [self readIndirect: count bytesFrom: aTIFFStream.].
! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:19'!
readImmediate: count bytesFrom: aTIFFStream
	"Put the next count bytes in aTIFFStream into my values array, starting from values at: 1. Leave aTIFFStream positioned four bytes past its starting position. Count must be <= 4."
	| position |
	position _ aTIFFStream position.
	(1 to: count) do: [:i | values at: i put: aTIFFStream nextByte].
	aTIFFStream position: position + 4.
	! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:56'!
readImmediate: count charsFrom: aTIFFStream
	"Read the next count bytes in aTIFFStream and return an Array of Strings, using NUL as the separating character between strings. Leave aTIFFStream positioned four bytes past its starting position. Count must be <= 4."
	| position result |
	position _ aTIFFStream position.
	result _ self read: count charsFrom: aTIFFStream.
	aTIFFStream position: position + 4.
	^ result.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:41'!
readImmediate: count longsFrom: aTIFFStream
	"Put the next count 32-bit longs in aTIFFStream into my values array, starting from values at: 1. Leave aTIFFStream positioned four bytes past its starting position. Count must be <= 1."
	| position |
	position _ aTIFFStream position.
	(1 to: count) do: [:i | values at: i put: aTIFFStream nextLong].
	aTIFFStream position: position + 4.
	! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:37'!
readImmediate: count shortsFrom: aTIFFStream
	"Put the next count 16-bit shorts in aTIFFStream into my values array, starting from values at: 1. Leave aTIFFStream positioned four bytes past its starting position. Count must be <= 2."
	| position |
	position _ aTIFFStream position.
	(1 to: count) do: [:i | values at: i put: aTIFFStream nextShort].
	aTIFFStream position: position + 4.
	! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:23'!
readIndirect: count bytesFrom: aTIFFStream
	"Read a long offset from aTIFFStream, then read count bytes from that offset in aTIFFStream into my values array, starting from values at: 1. Leave aTIFFStream positioned four bytes past its starting position."
	| offset position |
	offset _ aTIFFStream nextLong.
	position _ aTIFFStream position.
	aTIFFStream position: offset.
	(1 to: count) do: [:i | values at: i put: aTIFFStream nextByte].
	aTIFFStream position: position.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:59'!
readIndirect: count charsFrom: aTIFFStream
	"Read a long offset from aTIFFStream, then read count bytes from that offset in aTIFFStream and return them as an Array of Strings, using NUL as the separating character between strings. Leave aTIFFStream positioned four bytes past its starting position."
	| offset position result |
	offset _ aTIFFStream nextLong.
	position _ aTIFFStream position.
	aTIFFStream position: offset.
	result _ self read: count charsFrom: aTIFFStream.
	aTIFFStream position: position.
	^ result.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:42'!
readIndirect: count longsFrom: aTIFFStream
	"Read a 32-bit offset from aTIFFStream, then read count 32-bit longs from that offset in aTIFFStream into my values array, starting from values at: 1. Leave aTIFFStream positioned four bytes past its starting position."
	| offset position |
	offset _ aTIFFStream nextLong.
	position _ aTIFFStream position.
	aTIFFStream position: offset.
	(1 to: count) do: [:i | values at: i put: aTIFFStream nextLong].
	aTIFFStream position: position.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:47'!
readIndirect: count rationalsFrom: aTIFFStream
	"Read a 32-bit offset from aTIFFStream, then read count 32-bit longs from that offset in aTIFFStream into my values array, starting from values at: 1. Leave aTIFFStream positioned four bytes past its starting position."
	| offset position |
	offset _ aTIFFStream nextLong.
	position _ aTIFFStream position.
	aTIFFStream position: offset.
	(1 to: count) do: [:i | values at: i put: (aTIFFStream nextLong / aTIFFStream nextLong)].
	aTIFFStream position: position.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:27'!
readIndirect: count shortsFrom: aTIFFStream
	"Read a long offset from aTIFFStream, then read count 16-bit shorts from that offset in aTIFFStream into my values array, starting from values at: 1. Leave aTIFFStream positioned four bytes past its starting position."
	| offset position |
	offset _ aTIFFStream nextLong.
	position _ aTIFFStream position.
	aTIFFStream position: offset.
	(1 to: count) do: [:i | values at: i put: aTIFFStream nextShort].
	aTIFFStream position: position.! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:40'!
readLongValuesFrom: aTIFFStream
	"Read the 32-bit count and count number of 32-bit values from aTIFFStream at its current position according to my type. Store the result as my array of values. Leave aTIFFStream positioned eight bytes past its starting position."

	| count |
	count _ aTIFFStream nextLong.
	values _ Array new: count.
	(count <= 1) "Offset is immediate data, not pointer to data."
		ifTrue: [self readImmediate: count longsFrom: aTIFFStream.]
		ifFalse: [self readIndirect: count longsFrom: aTIFFStream.].
! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:46'!
readRationalValuesFrom: aTIFFStream
	"Read the 32-bit count and count number of 64-bit rational values from aTIFFStream at its current position according to my type. Store the result as my array of values. Leave aTIFFStream positioned eight bytes past its starting position."

	| count |
	count _ aTIFFStream nextLong.
	values _ Array new: count.
	"Can't fit even one rational into 32 bits, so always indirect, never immediate."
	self readIndirect: count rationalsFrom: aTIFFStream.
! !

!TIFFField methodsFor: 'private-value reading' stamp: 'mrm 7/27/2001 16:38'!
readShortValuesFrom: aTIFFStream
	"Read the 32-bit count and count number of 16-bit shorts from aTIFFStream at its current position according to my type. Store the result as my array of values. Leave aTIFFStream positioned eight bytes past its starting position."

	| count |
	count _ aTIFFStream nextLong.
	values _ Array new: count.
	(count <= 2) "Offset is immediate data, not pointer to data."
		ifTrue: [self readImmediate: count shortsFrom: aTIFFStream.]
		ifFalse: [self readIndirect: count shortsFrom: aTIFFStream.].
! !

!TIFFField methodsFor: 'accessing' stamp: 'mrm 7/27/2001 17:50'!
tag
	"Return the tag integer that indicates what kind of TIFF field this is."
	^ tag.
! !

!TIFFField methodsFor: 'accessing' stamp: 'mrm 7/31/2001 20:12'!
tagSymbol
	"Answer the Symbol that indicates what kind of TIFF field this is.
	If it's an unknown tag, answer nil."
	^ TagSymbols at: tag ifAbsent: [nil].
! !

!TIFFField methodsFor: 'accessing' stamp: 'mrm 7/28/2001 13:38'!
value
	"Answer my value. All TIFF fields are structured with array values, but many tags never have an array with more than one value. Thus, I answer the sole value for such tags, and answer an array for tags that can have more than one value.
	I report an error if I have more than one value for a tag that should only have one value."

	^ (self isSingleValued) 
		ifTrue: [values at: 1]
		ifFalse: [values].! !

!TIFFField methodsFor: 'printing' stamp: 'mrm 7/31/2001 21:51'!
printOn: aStream

	super printOn: aStream.
	values printOn: aStream.! !


!TIFFField class methodsFor: 'instance creation' stamp: 'mrm 7/25/2001 22:22'!
parseFrom: aTIFFStream
	"Answer a new instance of the receiver resulting from parsing the given TIFFStream from its current position. Leave the stream positioned after the field, which will be the beginning of the next field, if any."

	^ self new parseFrom: aTIFFStream.! !

!TIFFField class methodsFor: 'initializing' stamp: 'mrm 7/28/2001 15:56'!
initialize
	"TIFFField initialize."

	self initializeValueReaderSelectors.
	self initializeTagSymbols.
	self initializeSingleValuedTagSymbols.
	self initializeDefaultFields.! !

!TIFFField class methodsFor: 'initializing' stamp: 'jmv 1/12/2011 15:58'!
initializeDefaultFields
	"DefaultFields				Dictionary -- maps tag symbols to the default field with that tag. Only maps tag symbols for which the TIFF spec defines a default."

	DefaultFields _ Dictionary new.
	DefaultFields
		at: #BitsPerSample "1-bit bi-level image."
		put: (TIFFField tag: 258 type: 3 values: (Array with: 1));

		at: #Compression "No compression"
		put: (TIFFField tag: 259 type: 3 values: (Array with: 1));

		at: #Predictor "No predictor"
		put: (TIFFField tag: 317 type: 3 values: (Array with: 1));
		
		at: #FillOrder "Lower column values in higher-order bits"
		put: (TIFFField tag: 266 type: 3 values: (Array with: 1));
		
		at: #GrayResponseUnit "hundredths"
		put: (TIFFField tag: 290 type: 3 values: (Array with: 2));
		
		"The defaults for MaxSampleValue and MinSampleValue are a function of BitsPerSample and SmaplesPerPixel, and I don't anticipate needing these fields for Squeak purposes, so defaults for them are not handled according to the spec."

		at: #NewSubfileType "Primary Image"
		put: (TIFFField tag: 254 type: 4 values: (Array with: 0));
		
		at: #Orientation "0, 0 is top left of image"
		put: (TIFFField tag: 274 type: 3 values: (Array with: 1));
		
		at: #PlanarConfiguration "Chunky"
		put: (TIFFField tag: 284 type: 3 values: (Array with: 1));
		
		at: #ResolutionUnit "Inch"
		put: (TIFFField tag: 296 type: 3 values: (Array with: 2));
		
		at: #RowsPerStrip "Effectively infinite"
		put: (TIFFField tag: 278 type: 4 values: (Array with: 16rFFFFFFFF));
		
		at: #SamplesPerPixel "One"
		put: (TIFFField tag: 277 type: 3 values: (Array with: 1));
		
		at: #Threshholding "No dithering or halftoning applied"
		put: (TIFFField tag: 263 type: 3 values: (Array with: 1)).
		
! !

!TIFFField class methodsFor: 'initializing' stamp: 'jmv 1/12/2011 15:59'!
initializeSingleValuedTagSymbols
	"SingleValuedTagSymbols		Set -- contains the tag symbols of the fields types that should have a value that consists of an array of length one."
	SingleValuedTagSymbols _ Set new.
	SingleValuedTagSymbols
		add: #CellLength ;
		add: #CellWidth ;
		add: #Compression ;
		add: #Predictor ;
		add: #DateTime ; "Should be a single String."
		add: #FillOrder ;
		add: #GrayResponseUnit ;
		add: #ImageLength ;
		add: #ImageWidth ;
		add: #NewSubfileType ;
		add: #Orientation ;
		add: #PhotometricInterpretation ;
		add: #PlanarConfiguration ;
		add: #ResolutionUnit ;
		add: #RowsPerStrip ;
		add: #SamplesPerPixel ;
		add: #SubfileType ;
		add: #Threshholding ;
		add: #XResolution ;
		add: #YResolution .
! !

!TIFFField class methodsFor: 'initializing' stamp: 'jmv 1/12/2011 15:58'!
initializeTagSymbols
	"TagSymbols					Dictionary -- maps TIFF tag integers to tag symbols."
	TagSymbols _ Dictionary new.
	TagSymbols
		at: 315 put: #Artist ;
		at: 258 put: #BitsPerSample ;
		at: 265 put: #CellLength ;
		at: 264 put: #CellWidth ;
		at: 320 put: #ColorMap ;
		at: 259 put: #Compression ;
		at: 317 put: #Predictor ;
		at: 33432 put: #Copyright ;
		at: 306 put: #DateTime ;
		at: 338 put: #ExtraSamples ;
		at: 266 put: #FillOrder ;
		at: 289 put: #FreeByteCounts ;
		at: 288 put: #FreeOffsets ;
		at: 291 put: #GrayResponseCurve ;
		at: 290 put: #GrayResponseUnit ;
		at: 316 put: #HostComputer ;
		at: 270 put: #ImageDescription ;
		at: 257 put: #ImageLength ;
		at: 256 put: #ImageWidth ;
		at: 271 put: #Make ;
		at: 281 put: #MaxSampleValue ;
		at: 280 put: #MinSampleValue ;
		at: 272 put: #Model ;
		at: 254 put: #NewSubfileType ;
		at: 274 put: #Orientation ;
		at: 262 put: #PhotometricInterpretation ;
		at: 284 put: #PlanarConfiguration ;
		at: 296 put: #ResolutionUnit ;
		at: 278 put: #RowsPerStrip ;
		at: 277 put: #SamplesPerPixel ;
		at: 305 put: #Software ;
		at: 279 put: #StripByteCounts ;
		at: 273 put: #StripOffsets ;
		at: 255 put: #SubfileType ;
		at: 263 put: #Threshholding ;
		at: 282 put: #XResolution ;
		at: 283 put: #YResolution .
! !

!TIFFField class methodsFor: 'initializing' stamp: 'mrm 7/27/2001 17:47'!
initializeValueReaderSelectors
	"ValueReaderSelectors 	Dictionary -- maps TIFF type integers to the selectors of the methods used to read field values of that type."

	ValueReaderSelectors _ Dictionary new.
	ValueReaderSelectors
		at: 1 put: #readByteValuesFrom: ;
		at: 2 put: #readAsciiValuesFrom: ;
		at: 3 put: #readShortValuesFrom: ;
		at: 4 put: #readLongValuesFrom: ;
		at: 5 put: #readRationalValuesFrom: .
! !

!TIFFField class methodsFor: 'defaults' stamp: 'mrm 7/28/2001 15:53'!
defaultFor: tagSymbol
		"Answer the default field for the given tag Symbol. Raise an error if there is no default field for the given tag Symbol."
	^ DefaultFields 
		at: tagSymbol
		ifAbsent: [self error: 'No default value for this tag.']. ! !

!TIFFField class methodsFor: 'private' stamp: 'mrm 7/28/2001 16:25'!
tag: tagInteger type: typeInteger values: valueArray
	"Answer a new instance with the given state."
	^ self new 
		tag: tagInteger
		type: typeInteger
		values: valueArray.! !


!TIFFImageFileDirectory methodsFor: 'private' stamp: 'mrm 7/31/2001 22:09'!
parseFrom: aTIFFStream
	"Blow away any former state I had and parse a new collection of fields from the given stream.
	Leave the stream positioned at the end of the IFD, just before the pointer to the next IFD."
	| fieldCount field |
	fieldCount _ aTIFFStream nextShort.
	fields _ (Dictionary new: fieldCount).
	fieldCount timesRepeat: 
		[field _ TIFFField parseFrom: aTIFFStream.
		field isNil ifFalse: [fields at: field tagSymbol put: field] ].
! !

!TIFFImageFileDirectory methodsFor: 'accessing' stamp: 'mrm 7/28/2001 15:52'!
at: tagSymbol
	"Answer the value I have for the given tag Symbol. If I have no value for that tag, return the default value for that tag. 
	All TIFF tags are structured with array values, but many tags never have an array with more than one value. Thus, I answer the sole value for such tags, and answer an array for tags that can have more than one value.
	I report an error if I have no value for a tag that has no default or if I have more than one value for a tag that should only have one value."

	| field |
	field _ fields 
		at: tagSymbol
		ifAbsent: 
			[TIFFField defaultFor: tagSymbol]. "Raises error if no default."
	^ field value.! !


!TIFFImageFileDirectory class methodsFor: 'instance creation' stamp: 'mrm 7/25/2001 22:22'!
parseFrom: aTIFFStream
	"Answer a new instance of the receiver resulting from parsing the given TIFFStream from its current position. Leave the stream positioned at the start of the next IFD, or at 0 if no more."
	^ self new parseFrom: aTIFFStream.! !


!TIFFReadWriter methodsFor: 'accessing' stamp: 'mrm 7/27/2001 21:54'!
nextImage
	"Decode an image on my stream and answer the image as a Form."
	| reader |
	reader _ TIFFReader on: stream.
	^ reader readForm.! !

!TIFFReadWriter methodsFor: 'accessing' stamp: 'mrm 7/22/2001 18:46'!
nextPutImage: aForm
	"Encode aForm into TIFF form and write on my stream."

	^self error: 'Not Yet Implemented.'.! !

!TIFFReadWriter methodsFor: 'testing' stamp: 'mrm 7/22/2001 19:07'!
understandsImageFormat
	"Test to see if the image stream format is understood by this decoder."
	"Return true if this stream appears to contain a TIFF file, otherwise 
	return false."

	"Check for Big-endian header."
	(self hasMagicNumber: 
		(ByteArray with: 16r4D with: 16r4D with: 16r00 with: 16r2A) )
		ifTrue: [ ^ true].

	"Check for little-endian header."
	^ (self hasMagicNumber: 
		(ByteArray with: 16r49 with: 16r49 with: 16r2A with: 16r00) ).! !

!TIFFReadWriter methodsFor: 'private' stamp: 'mrm 7/27/2001 21:51'!
on: aPositionableStream
	"Reset the given Stream, wrap it in a TIFFStream, and set it as my stream."

	| bigEndian |
	super on: aPositionableStream.
	bigEndian _ (aPositionableStream peek) = 16r4D. 
		"Assume 16r49 or 16r4D. Bad first byte caught later by TIFFStructure>>validateHeaderOf:"
	stream _ TIFFStream 
		on: aPositionableStream 
		bigEndian: bigEndian.! !


!TIFFReader methodsFor: 'private' stamp: 'mrm 7/27/2001 22:10'!
on: aTIFFStream
	"Set the given stream as my stream, and read the TIFF's structure from that stream."
	stream _ aTIFFStream.
	structure _ TIFFStructure parseFrom: stream.
! !

!TIFFReader methodsFor: 'private' stamp: 'jmv 1/12/2011 16:52'!
positionStreamToStripNum: anInteger
	"Position my TIFFStream at the start of the given strip, where 1 is the first strip."
	stream position: ((structure at: #StripOffsets) at: anInteger).
	stream newStrip! !

!TIFFReader methodsFor: 'private' stamp: 'jmv 1/13/2011 10:14'!
readPixelsInto: aForm readAlpha: doReadAlpha horizontalPredictor: useHorizontalPredictor
	"Replace the given Form's pixel values with pixel values from my TIFFStream. aForm must have the correct extent. Only handles 32-bit pixels on both source and destination."

	| bits totalPixels pixelsPerStrip currentStripNum pixel a b g r aa bb rr gg | 
	bits _ aForm bits.
	totalPixels _ bits size.
	pixelsPerStrip _ aForm extent x * (structure at: #RowsPerStrip).
	currentStripNum _ 0.
	a _ 255.

	(1 to: totalPixels) do: [ :pixNum |
		(pixNum-1 \\ aForm width = 0) ifTrue: [
			(pixNum - 1 \\ pixelsPerStrip = 0) ifTrue: [
				"Time to go to next strip"
				currentStripNum _ currentStripNum + 1.
				self positionStreamToStripNum: currentStripNum ].
			useHorizontalPredictor ifTrue: [
				r _ g _ b _ 0.
				a _ doReadAlpha ifTrue: [ 0 ] ifFalse: [ 255 ] ]].

		rr _ stream nextByteInBody.
		gg _ stream nextByteInBody.
		bb _ stream nextByteInBody.
		doReadAlpha
			ifTrue: [ aa _ stream nextByteInBody ].

		useHorizontalPredictor
			ifTrue: [
				r _ (r + rr) bitAnd: 255.
				g _ (g + gg) bitAnd: 255.
				b _ (b + bb) bitAnd: 255.
				doReadAlpha
					ifTrue: [ a _ (a + aa) bitAnd: 255 ] ]
			ifFalse: [
				r _ rr.
				g _ gg.
				b _ bb.
				doReadAlpha
					ifTrue: [ a _ aa ] ].
		pixel _ (r << 16) + (g << 8) + b + (a << 24).
		bits at: pixNum put: pixel.].! !

!TIFFReader methodsFor: 'private' stamp: 'jmv 1/12/2011 16:02'!
validateTIFFType
	"Examine my structure to see if it represents a TIFF that I know how to read. 
	At the moment, I can read only RGB 32-bit TIFFs with an alpha channel, uncompressed, chunky."
	| bpsArray compression predictor |
	((structure at: #PhotometricInterpretation) = 2) "RGB"
		ifFalse: [self error: 'Cannot read, this is not an RGB TIFF.'].
	((structure at: #SamplesPerPixel) between: 3 and: 4) 
		ifFalse: [self error: 'Cannot read, this TIFF is not a RGB TIFF or RGBA TIFF.'].
	compression _ structure at: #Compression.
	(compression = 1 or: [ compression = 5 ]) "Uncompressed (1) or LZW (5)"
		ifFalse: [self error: 'Cannot read, this TIFF is compressed with an unsupported algorithm.'].
	predictor _ structure at: #Predictor.
	(predictor = 1 or: [ predictor = 2 and: [ compression = 5]])
		ifFalse: [self error: 'Cannot read, this TIFF uses an unsupported predictor.'].
	((structure at: #FillOrder) = 1) 
		ifFalse: [self error: 'Cannot read, this TIFF has a FillOrder other than 1.'].
	((structure at: #Orientation) = 1) 
		ifFalse: [self error: 'Cannot read, this TIFF has an Orientation other than 1.'].
	((structure at: #PlanarConfiguration) = 1) 
		ifFalse: [self error: 'Cannot read, this TIFF is planar, not chunky.'].
	bpsArray _ structure at: #BitsPerSample.
	((bpsArray size = 3 or: [ bpsArray size = 4 ]) and: [ bpsArray allSatisfy: [ :d | d = 8 ] ])
		ifFalse: [self error: 'Cannot read, this TIFF is not a 24-bit RGB TIFF (or same with an 8-bit alpha channel).'].
! !

!TIFFReader methodsFor: 'reading' stamp: 'jmv 1/12/2011 16:45'!
readForm
	"Answer a Form created from the data in my stream and structure."
	| result |
	self validateTIFFType. "Make sure it's a type we can handle."
	result _ Form 
				extent: self extent
				depth: 32. "We only do 32-bit Forms for now."
	self
		readPixelsInto: result
		readAlpha: (structure at: #SamplesPerPixel) = 4
		horizontalPredictor: ((structure at: #Predictor) = 2).
	^ result! !

!TIFFReader methodsFor: 'accessing' stamp: 'mrm 7/28/2001 17:03'!
extent
	"Answer a Point that defines my image's size in pixels."
	^ (structure at: #ImageWidth) @ (structure at: #ImageLength).
! !


!TIFFReader class methodsFor: 'instance creation' stamp: 'mrm 7/27/2001 22:08'!
on: aTIFFStream
	"Create and answer an instance of the receiver based on the given TIFFStream. Parse the structure at this time as well."
	^ self new on: aTIFFStream.
! !


!TIFFStream methodsFor: 'private' stamp: 'mrm 7/22/2001 20:34'!
on: aPositionableStream bigEndian: aBoolean

	"Make aPositionableStream be the stream I'm wrapping. Interpret it as big or little-endian according to aBoolean."
	stream _ aPositionableStream.
	bigEndian _ aBoolean.
! !

!TIFFStream methodsFor: 'stream access' stamp: 'jmv 1/12/2011 13:12'!
close
	stream close! !

!TIFFStream methodsFor: 'stream access' stamp: 'mrm 7/22/2001 20:23'!
next: anInteger

	"Answer the next anInteger elements of my stream's collection."
	^ stream next: anInteger.! !

!TIFFStream methodsFor: 'stream access' stamp: 'mrm 7/27/2001 17:35'!
peek

	"Answer the next byte of my underlying stream."
	^ stream peek.

! !

!TIFFStream methodsFor: 'stream access' stamp: 'mrm 7/22/2001 20:11'!
position

	"Answer the current position of accessing the sequence of objects."
	^ stream position.! !

!TIFFStream methodsFor: 'stream access' stamp: 'mrm 7/22/2001 20:18'!
position: anInteger 

	"Set the current position for accessing the objects to be anInteger, as long 
	as anInteger is within the bounds of the receiver's contents. If it is not, 
	create an error notification."
	stream position: anInteger.! !

!TIFFStream methodsFor: 'stream access' stamp: 'jmv 1/12/2011 10:01'!
reset
	"Goto start."
	stream reset! !

!TIFFStream methodsFor: 'stream access' stamp: 'mrm 7/22/2001 20:13'!
size

	"Answer the size of my underlying stream."
	^ stream size.

! !

!TIFFStream methodsFor: 'stream access' stamp: 'mrm 7/31/2001 21:44'!
skip: anInteger
	"Set the receiver's position to be the current position+anInteger."

	stream skip: anInteger.! !

!TIFFStream methodsFor: 'accessing' stamp: 'jmv 1/12/2011 16:05'!
compressionType: aNumber
	compressionType _ aNumber.
	aNumber = 5 ifTrue: [
		self initializeLZWDecompression ]! !

!TIFFStream methodsFor: 'accessing' stamp: 'mrm 7/22/2001 21:59'!
isBigEndian
	"Return true if I am a big-endian TIFF, false if I am little-endian."
	^ bigEndian.
! !

!TIFFStream methodsFor: 'TIFF type access' stamp: 'jmv 1/12/2011 17:02'!
newStrip
	remainBitCount _ 0.
	self reInitializeLZWDecompression! !

!TIFFStream methodsFor: 'TIFF type access' stamp: 'mrm 7/27/2001 17:49'!
nextByte
	"Answer the next 8-bit unsigned quantity from the stream."

	^ stream next.! !

!TIFFStream methodsFor: 'TIFF type access' stamp: 'jmv 1/13/2011 10:13'!
nextByteInBody
	"Answer the next 8-bit unsigned quantity from the stream.
	Uncompress data if appropriate"
	compressionType = 5 ifTrue: [
		^self nextLZWUncompressedByte ].
	^ stream next! !

!TIFFStream methodsFor: 'TIFF type access' stamp: 'mrm 7/23/2001 21:52'!
nextLong
	"Answer the next 32-bit unsigned quantity from the stream."

	^ bigEndian
		ifTrue: [(stream next bitShift: 24) +
				(stream next bitShift: 16) +
				(stream next bitShift: 8) + 
				stream next]
		ifFalse: [stream next + 
				(stream next bitShift: 8) +
				(stream next bitShift: 16) +
				(stream next bitShift: 24)].! !

!TIFFStream methodsFor: 'TIFF type access' stamp: 'mrm 7/22/2001 22:05'!
nextShort
	"Answer the next 16-bit unsigned quantity from the stream."

	^ bigEndian
		ifTrue: [(stream next bitShift: 8) + stream next]
		ifFalse: [stream next + (stream next bitShift: 8)].! !

!TIFFStream methodsFor: 'LZW uncompressions' stamp: 'jmv 1/12/2011 16:52'!
checkLZWCodeSize

	(freeCode+1 > maxCode and: [ codeSize < 12 ]) ifTrue: [
		codeSize := codeSize + 1.
		maxCode := (1 bitShift: codeSize) - 1 ]! !

!TIFFStream methodsFor: 'LZW uncompressions' stamp: 'jmv 1/12/2011 16:57'!
initializeLZWDecompression

	maxOutCodes := 4096.
	remainBitCount := 0.
	outCodes := ByteArray new: maxOutCodes + 1.
	outCount := 0.
	prefixTable := Array new: 4096.
	suffixTable := Array new: 4096.
	bitMask := (1 bitShift: 8) - 1! !

!TIFFStream methodsFor: 'LZW uncompressions' stamp: 'jmv 1/12/2011 17:02'!
nextLZWCode
	| 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 ].
		remainBitCount = 0 ifFalse: [
			byte _ byte bitAnd: (1 bitShift: remainBitCount)-1.
			remainBitCount _ 0 ].
		integer := (integer bitShift: 8) + byte.
		shiftCount := shiftCount + 8.
		readBitCount := readBitCount + 8 ].
	(remainBitCount := readBitCount - codeSize) = 0 
		ifTrue: [ byte := self nextByte ]
		ifFalse: [ byte := self peek ].
	byte == nil ifTrue: [ ^ eoiCode ].
	integer := (integer bitShift: 8) + byte.
	integer _ integer bitShift: remainBitCount negated.
	^integer! !

!TIFFStream methodsFor: 'LZW uncompressions' stamp: 'jmv 1/12/2011 17:04'!
nextLZWUncompressedByte
	"Answer the next 8-bit unsigned quantity from the stream."
	| answer |
	outCount = 0 ifTrue: [
		self readAdditionalLZWStuff ].
	
	answer _ outCodes at: outCount.
	outCount _ outCount - 1.
	^answer! !

!TIFFStream methodsFor: 'LZW uncompressions' stamp: 'jmv 1/12/2011 15:18'!
reInitializeLZWDecompression
	clearCode := 1 bitShift: 8.
	eoiCode := clearCode + 1.
	freeCode := clearCode + 2.
	codeSize := 9.	
	maxCode := (1 bitShift: codeSize) - 1! !

!TIFFStream methodsFor: 'LZW uncompressions' stamp: 'jmv 1/12/2011 17:13'!
readAdditionalLZWStuff
	"Answer the next 8-bit unsigned quantity from the stream."
	| code curCode inCode |
	code := self nextLZWCode.
	code = eoiCode ifTrue: [
		^nil ].

	code = clearCode 
		ifTrue: [
			self reInitializeLZWDecompression.
			curCode := oldCode := code := self nextLZWCode.
			finChar := curCode]
		ifFalse: [
			curCode := inCode := code.
			curCode >= freeCode ifTrue: [
				curCode := oldCode.
				outCodes 
					at: (outCount := outCount + 1)
					put: finChar ].
			[ curCode > bitMask ] whileTrue: [
				outCount > maxOutCodes ifTrue: [ ^ self error: 'corrupt LZW TIFF file (OutCount)' ].
				outCodes 
					at: (outCount := outCount + 1)
					put: (suffixTable at: curCode + 1).
				curCode := prefixTable at: curCode + 1 ].
			finChar := curCode.
			prefixTable 
				at: freeCode + 1
				put: oldCode.
			suffixTable 
				at: freeCode + 1
				put: finChar.
			oldCode := inCode.
			freeCode := freeCode + 1.
			self checkLZWCodeSize ].
	outCodes 
		at: (outCount := outCount + 1)
		put: finChar! !


!TIFFStream class methodsFor: 'instance creation' stamp: 'mrm 7/22/2001 20:42'!
on: aPositionableStream bigEndian: aBoolean

	"Answer an instance of the receiver for encoding and/or decoding TIFFs on the given."

	^ self new 
		on: aPositionableStream 
		bigEndian: aBoolean.
! !


!TIFFStructure methodsFor: 'parsing' stamp: 'jmv 1/12/2011 16:06'!
parseFrom: aTIFFStream
	"Parse the given TIFFStream and set my internal state to match. Error if the TIFFStream does not contain a valid TIFF."

	"Wipe out any former contents."
	imageFileDirectories _ OrderedCollection new.

	self validateHeaderOf: aTIFFStream.
	self parseIFDsFrom: aTIFFStream.
	aTIFFStream compressionType: (self at: #Compression)! !

!TIFFStructure methodsFor: 'parsing' stamp: 'mrm 7/31/2001 22:09'!
parseIFDsFrom: aTIFFStream
	"Read as many image file directories as aTIFFStream contains, and put them into my state. Per the TIFF spec, there must be at least one IFD."

	| ifd ifdPosition |
	aTIFFStream position: 4. "Offset in header of pointer to first IFD."
	ifdPosition _ aTIFFStream nextLong.
	[ifdPosition ~~ 0] 
		whileTrue: [
			aTIFFStream position: ifdPosition.
			ifd _ TIFFImageFileDirectory parseFrom: aTIFFStream.
			imageFileDirectories add: ifd.
			ifdPosition _ aTIFFStream nextLong].
! !

!TIFFStructure methodsFor: 'parsing' stamp: 'jmv 1/12/2011 10:01'!
validateHeaderOf: aTIFFStream
	"Report an error if the header of the given stream is not valid, 
	or does not match the endian-ness of the TIFFStream."

	| expectedWord douglasAdams |
	expectedWord _ aTIFFStream isBigEndian 
		ifTrue: [16r4D4D]
		ifFalse: [16r4949].
	douglasAdams _ 42.
	aTIFFStream reset.
	(aTIFFStream nextShort = expectedWord) 
		ifFalse: [self error: 'TIFF Header not valid. First word not correct for expected endian-ness'].
	(aTIFFStream nextShort = douglasAdams) 
		ifFalse: [self error: 'TIFF Header not valid. Answer not 42.'].

	
! !

!TIFFStructure methodsFor: 'accessing' stamp: 'mrm 7/28/2001 09:33'!
at: tagSymbol
	"Answer the value I have for the given tag Symbol. If I have no value for that tag, return the default value for that tag. 
	All TIFF tags are structured with array values, but many tags never have an array with more than one value. Thus, I answer the sole value for such tags, and answer an array for tags that can have more than one value.
	I report an error if I have no value for a tag that has no default or if I have more than one value for a tag that should only have one value.
	I only look in my first image file directory for values."

	| ifd |
	ifd _ imageFileDirectories first. "Reports an error if no IFDs."
	^ ifd at: tagSymbol.! !


!TIFFStructure class methodsFor: 'instance creation' stamp: 'mrm 7/25/2001 21:52'!
parseFrom: aTIFFStream
	"Answer a new instance of the receiver resulting from parsing the given TIFFStream from a position of 0. Error if the TIFFStream does not contain a valid TIFF."

	^ self new parseFrom: aTIFFStream.! !

TIFFField initialize!