hg/stx-libview2: comparison TIFFReader.st

equal deleted inserted replaced

-:842b6a603cdc
+:78aaa5408119
 !TIFFReader class methodsFor:'documentation'!
 documentation
 "
-This class knows how to read TIFF files (and will
+This class knows how to read TIFF files and how to
-learn sometime in the future how to write them).
+write uncompressed TIFF files.
-Currently, not all formats are implemented and of
+Only single image files are supported.
-those that are, not all are tested.
+Currently, not all formats are implemented, and of
+those that are not all are tested.
 It should work with most rgb, mono and 2-plane greyscale
 images, since this is what I have as test material on
 the NeXT.
-It supports uncompressed, LZW and G3 compressed images;
+It supports reading of uncompressed, LZW and G3 compressed
-JPEG is currently not implemented.
+images; JPEG and pacbits are currently not implemented.
-More formats and compressions will come ...
+Only writing of uncompressed images is currently implemented.
+More formats will come ...
 "
 ! !
+!TIFFReader class methodsFor:'testing'!
+isValidImageFile:aFileName
+"return true, if aFileName contains a GIF image"
+|inStream char1 char2 version|
+inStream := FileStream readonlyFileNamed: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:'reading from file'!
 fromFile:aFileName
+"read an image from aFileName"
 |char1 char2 version
 numberOfTags "{ Class: SmallInteger }"
 tagType      "{ Class: SmallInteger }"
 numberType   "{ Class: SmallInteger }"
 length       "{ Class: SmallInteger }"
 'not a tiff file' printNewline.
 inStream close.
 ^ nil
 ]
 ].
+inStream binary.
 version := self readShort.
 (version ~~ 42) ifTrue:[
 'version of tiff-file not supported' printNewline.
 inStream close.
 offset := self readLong + 1.
 inStream position:offset.
 numberOfTags := self readShort.
-1 to:(numberOfTags) do:[:index |
+1 to:numberOfTags do:[:index |
 tagType := self readShort.
 numberType := self readShort.
 length := self readLong.
-self decodeTiffTag:tagType numberType:numberType
+self decodeTiffTag:tagType numberType:numberType length:length
-length:length
 ].
 offset := self readLong.
 (offset ~~ 0) ifTrue:[
 'more tags ignored' printNewline
 ].
+"check for required tags"
 ok := true.
 width isNil ifTrue:[
 'missing width tag' printNewline.
 ok := false
 ].
 result := self readPackbitsTiffImageData
 ] ifFalse:[
 (compression == 32865) ifTrue:[
 result := self readJPEGTiffImageData
 ] ifFalse:[
-'compression type not known' printNewline
+'compression type ' , compression printString , ' not known' printNewline
 ]
 ]
 ]
 ]
 ]
 ! !
 !TIFFReader methodsFor:'writing to file'!
 save:image onFile:aFileName
-"save image as TIFF file on aFileName"
+"save image as (uncompressed) TIFF file on aFileName"
 |pos1 pos|
 outStream := FileStream newFileNamed:aFileName.
 outStream isNil ifTrue:[
 'create error' printNewline.
 ^ nil
 ].
+"save as msb"
 byteOrder := #msb.
+"
+byteOrder := #lsb.
+"
 fillOrder := #msb.
 width := image width.
 height := image height.
 photometric := image photometric.
 samplesPerPixel := image samplesPerPixel.
 colorMap := image colorMap.
 planarConfiguration := 1.
 compression := 1.   "none"
 data := image bits.
-"save as msb"
 currentOffset := 0.
-outStream nextPut:$M.
+(byteOrder == #msb) ifTrue:[
 outStream nextPut:$M.
+outStream nextPut:$M.
+] ifFalse:[
+outStream nextPut:$I.
+outStream nextPut:$I.
+].
 currentOffset := currentOffset + 2.
 outStream binary.
-self writeShort:42.         "version"
+self writeShort:42.
 currentOffset := currentOffset + 2.
 pos1 := outStream position.
-self writeLong:0.           "start of commands - filled in later"
+self writeLong:0.           "start of tags - filled in later"
 currentOffset := currentOffset + 4.
 "output strips"
 self writeBits.             "this outputs bits as strips, sets stripOffsets and stripByteCounts"
 self writeBitsPerSample.    "this outputs bitsPerSample, sets bitsPerSamplePos"
 photometric == #palette ifTrue:[
 self writeColorMap      "this outputs colorMap, sets colorMapPos"
 ].
-pos := outStream position.  "backpatch tag offset"
+pos := outStream position.                  "backpatch tag offset"
 outStream position:pos1.
-self writeLong:(pos - 1).
+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:9
+self writeShort:9.  "9 tags"
 ] ifFalse:[
-self writeShort:8.          "8 tags"
+self writeShort:8.  "8 tags"
 ].
 self writeTag:256.               "image width"
 self writeTag:257.               "image height"
 self writeTag:258.               "bits per sample"
 self writeTag:259.               "compression"
 self writeTag:279.               "strip byte counts"
 self writeTag:284.               "planarconfig"
 photometric == #palette ifTrue:[
 self writeTag:320            "colorMap"
 ].
-self writeLong:0.
+self writeLong:0.                "end of tags mark"
-outStream close
 ! !
 !TIFFReader methodsFor:'private'!
 readLongs:n
 |oldPos offset values|
 values := Array new:n.
 (n == 1) ifTrue:[
-values at:1 put:(self readLong)
+values at:1 put:self readLong.
 ] ifFalse:[
 offset := self readLong.
 oldPos := inStream position.
 inStream position:(offset + 1).
 1 to:n do:[:index |
-values at:index put:(self readLong)
+values at:index put:self readLong
 ].
 inStream position:oldPos
 ].
 ^ values
 !
 readShorts:n
 |oldPos offset values|
 values := Array new:n.
 (n <= 2) ifTrue:[
-values at:1 put:(self readShort).
+values at:1 put:self readShort.
 (n == 2) ifTrue:[
-values at:2 put:(self readShort)
+values at:2 put:self readShort
 ] ifFalse:[
 self readShort
 ]
 ] ifFalse:[
 offset := self readLong.
 oldPos := inStream position.
 inStream position:(offset + 1).
 1 to:n do:[:index |
-values at:index put:(self readShort)
+values at:index put:self readShort
 ].
 inStream position:oldPos
 ].
 ^ values
 !
 stripByteCounts := (Array new:height) atAllPut:bytesPerRow.
 offs := 1.
 1 to:height do:[:row |
 stripOffsets at:row put:(outStream position - 1).
-outStream nextPutBytes:data size from:data startingAt:offs.
+outStream nextPutBytes:bytesPerRow from:data startingAt:offs.
 offs := offs + bytesPerRow
 ].
 rowsPerStrip := 1
 ].
 'stripOffsets: ' print. stripOffsets printNewline.
 writeColorMap
 colorMapPos := outStream position.
 colorMap do:[:subMap |
 subMap do:[:entry |
 "my maps are 8 bit - tiff map is 16 bit"
+entry isNil ifTrue:[
-self writeShort:(entry / 255 * 16rFFFF) rounded
+"unused map entry"
+self writeShort:0
+] ifFalse:[
+self writeShort:(entry / 255 * 16rFFFF) rounded
+]
 ]
 ]
 !
 writeStripOffsets
+"
 'stripOffsets: ' print. stripOffsets printNewline.
 'store stripoffsets at: ' print. outStream position printNewline.
+"
 stripOffsetsPos := outStream position.
 stripOffsets do:[:o |
 self writeLong:o
 ]
 !
 writeStripByteCounts
+"
 'stripByteCounts: ' print. stripByteCounts printNewline.
 'store stripbytecounts at: ' print. outStream position printNewline.
+"
 stripByteCountsPos := outStream position.
 stripByteCounts do:[:c |
 self writeShort:c
 ]
 !
 writeBitsPerSample
+"
 'bitsPerSample: ' print. bitsPerSample printNewline.
 'store bitspersample at: ' print. outStream position printNewline.
+"
 bitsPerSamplePos := outStream position.
 bitsPerSample do:[:n |
 self writeShort:n
 ]
 !
 offset := offset + bytesPerStrip.
 row := row + rowsPerStrip
 ].
 (predictor == 2) ifTrue:[
-	self class decodeDelta:3 in:data width:width height:height
+self class decodeDelta:3 in:data width:width height:height
 ]
 !
 readCCITTGroup3TiffImageData
 "not really tested - all I got is a single
 bytesPerRow := bitsPerRow // 8.
 ((bitsPerRow \\ 8) ~~ 0) ifTrue:[
 bytesPerRow := bytesPerRow + 1
 ].
-data := ByteArray uninitializedNew:(bytesPerRow * height).
+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)
+inStream nextBytes:(stripByteCounts at:stripNr) into:compressedStrip.
-into:compressedStrip.
 self class decompressCCITT3From:compressedStrip
 into:data
 startingAt:offset
 count:width.
 offset := offset + bytesPerStrip.

changeset 3	78aaa5408119
parent 0	3f9277473954
child 5	4d55b551dc57