"
 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.
"
!

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 read 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.
    It should write (at least) mono, 8-bit palette and 24 bit rgb formats.
    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.

    [author:]
        Claus Gittinger

    [See also:]
        Image Form Icon
        BlitImageReader FaceReader GIFReader JPEGReader PBMReader PCXReader 
        ST80FormReader SunRasterReader TargaReader WindowsIconReader 
        XBMReader XPMReader XWDReader 
"
! !

!TIFFReader class methodsFor:'initialization'!

initialize
    "install myself in the Image classes fileFormat table
     for the `.tiff', `.tif' and '.TIF' extensions."

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

    "Modified: 23.4.1996 / 12:28:57 / cg"
! !

!TIFFReader class methodsFor:'testing'!

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

    ^ true
!

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
! !

!TIFFReader methodsFor:'private'!

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 [warning]: unknown tag type ' errorPrint. tagType errorPrintCR

    "Modified: 10.1.1997 / 18:07:34 / cg"
!

readCCITT3RLETiffImageData
     'TIFFReader [warning]: ccitt mod Huffman (rle) compression not implemented' errorPrintCR.

    "Modified: 10.1.1997 / 18:09:02 / cg"
!

readCCITT3RLEWTiffImageData
     'TIFFReader [warning]: ccitt mod Huffman (rlew) compression not implemented' errorPrintCR.

    "Modified: 10.1.1997 / 18:09:11 / cg"
!

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 [info]: ignoring alpha plane' infoPrintCR.
        nPlanes := 1
    ].

    (nPlanes ~~ 1) ifTrue:[
        'TIFFReader [warning]: only monochrome/greyscale supported' errorPrintCR.
        ^ nil
    ].

    stripByteCounts isNil ifTrue:[
        'TIFFReader [warning]: currently require stripByteCounts' errorPrintCR.
        ^ nil
    ].
    (rowsPerStrip ~~ 1) isNil ifTrue:[
        'TIFFReader [warning]: currently require rowsPerStrip to be 1' errorPrintCR.
        ^ 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
    ]

    "Modified: 10.1.1997 / 18:14:56 / cg"
!

readCCITTGroup4TiffImageData
    'TIFFReader [warning]: ccitt group4 fax compression not implemented' errorPrintNL.

    "Modified: 10.1.1997 / 18:09:14 / cg"
!

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

    |oldPos offset string|

    n == 0 ifTrue:[^ ''].

    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

    "Modified: 5.9.1996 / 12:21:08 / cg"
!

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
!

readJPEGTiffImageData
    'TIFFReader [warning]: jpeg compression not implemented' errorPrintNL

    "Modified: 10.1.1997 / 18:09:17 / cg"
!

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) 
        or:[((bitsPerSample at:2) ~~ 8) 
        or:[((bitsPerSample at:3) ~~ 8)]]) ifTrue:[
            'TIFFReader [warning]: only 8/8/8 bit/sample are supported' errorPrintCR.
            ^ nil
        ].
        bytesPerRow := width * samplesPerPixel.
    ] ifFalse:[
        (nPlanes == 2) ifTrue:[
            (planarConfiguration ~~ 2) ifTrue:[
                'TIFFReader [warning]: only separate planes are supported' errorPrintCR.
                ^ nil
            ].
            'TIFFReader [info]: ignoring alpha plane' infoPrintCR.
            nPlanes := 1
        ].
        (nPlanes == 1) ifFalse:[
            'TIFFReader [warning]: only 3-sample rgb / monochrome supported' errorPrintCR.
            ^ nil
        ].
        bytesPerRow := (width * (bitsPerSample at:1) + 7) // 8.
    ].

    stripByteCounts isNil ifTrue:[
        'TIFFReader [warning]: currently require stripByteCounts' errorPrintCR.
        ^ 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
    ]

    "Modified: 10.1.1997 / 18:13:21 / cg"
!

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
!

readNeXTJPEGTiffImageData
    'TIFFReader [warning]: jpeg compression not implemented' errorPrintCR

    "Modified: 10.1.1997 / 18:11:04 / cg"
!

readNeXTRLE2TiffImageData
    'TIFFReader [warning]: next 2bit rle compression not implemented' errorPrintCR.

    "Modified: 10.1.1997 / 18:11:01 / cg"
!

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

    'TIFFReader [warning]: packbits compression not implemented' errorPrintCR

    "Modified: 10.1.1997 / 18:10:57 / cg"
!

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
!

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:[
            'TIFFReader [warning]: with alpha, only separate planes supported' errorPrintCR.
            ^ nil
        ].
        'TIFFReader [info]: ignoring alpha plane' infoPrintCR.
        nPlanes := 1.
        bitsPerPixel := bitsPerSample at:1.
        bitsPerSample := Array with:bitsPerPixel.
        samplesPerPixel := 1.
    ] ifFalse:[
        (nPlanes == 3) ifTrue:[
            (planarConfiguration ~~ 1) ifTrue:[
                'TIFFReader [warning]: only non separate planes supported' errorPrintCR.
                ^ nil
            ].
            bitsPerSample ~= #(8 8 8) ifTrue:[
                'TIFFReader [warning]: only 8/8/8 rgb images supported' errorPrintCR.
                ^ nil
            ].
            bitsPerPixel := 24
        ] ifFalse:[
            (nPlanes ~~ 1) ifTrue:[
                'TIFFReader [warning]: format not supported' errorPrintCR.
                ^ 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 := 0.
    stripNr := 0.

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

        offset + nBytes > overAllBytes ifTrue:[
            nBytes := overAllBytes - offset.
        ].

        inStream nextBytes:nBytes into:data startingAt:offset+1.
        offset := offset + nBytes.
        row := row + rowsPerStrip
    ]

    "Modified: 10.1.1997 / 18:10:46 / cg"
!

writeBitsPerSample
"
'bitsPerSample: ' print. bitsPerSample printNewline.
'store bitspersample at: ' print. outStream position printNewline.
"
    bitsPerSamplePos := outStream position.
    bitsPerSample do:[:n |
	self writeShort:n
    ]
!

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.
	]
    ]
!

writeStripByteCounts
"
'stripByteCounts: ' print. stripByteCounts printNewline.
'store stripbytecounts at: ' print. outStream position printNewline.
"
    stripByteCountsPos := outStream position.
    stripByteCounts do:[:c |
	self writeShort:c
    ]
!

writeStripOffsets
"
'stripOffsets: ' print. stripOffsets printNewline.
'store stripoffsets at: ' print. outStream position printNewline.
"
    stripOffsetsPos := outStream position.
    stripOffsets do:[:o |
	self writeLong:o
    ]
!

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'
	    ]
	]
    ].
!

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.
"
! !

!TIFFReader methodsFor:'reading from file'!

fromStream:aStream
    "read a stream containing a TIFF image.
     Leave image description in instance variables."

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

    inStream := aStream.
    aStream binary.

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

    version := self readShort.
    (version ~~ 42) ifTrue:[
        'TIFFReader [warning]: version of tiff-file not supported' errorPrintCR.
        ^ 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 [info]: more tags ignored' infoPrintCR
    ].

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

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

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

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

    stripByteCounts isNil ifTrue:[
        stripOffsets size == 1 ifTrue:[
            stripByteCounts := Array with:(self bitsPerPixel // 8) * width * height
        ]
    ].

    stripByteCounts isNil ifTrue:[
        'TIFFReader [warning]: missing stripByteCounts tag' errorPrintCR.
        ok := false
    ].

    ok ifFalse:[
        ^ nil
    ].

    dimensionCallBack notNil ifTrue:[
        dimensionCallBack value:self
    ].

    "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 [warning]: compression type ' errorPrint. compression errorPrint.
        ' not known' errorPrintCR
    ].
    ^ result

    "Modified: 10.1.1997 / 18:08:54 / cg"
! !

!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 [warning]: create error' errorPrintCR. 
        ^ 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:11.  "11 tags"
    ] ifFalse:[
        self writeShort:10.  "10 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:277.               "samplesPerPixel"
    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

    "Modified: 10.1.1997 / 18:13:38 / cg"
! !

!TIFFReader class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/TIFFReader.st,v 1.44 1997-01-10 17:32:24 cg Exp $'
! !
TIFFReader initialize!