TIFFRdr.st
changeset 3 78aaa5408119
parent 0 3f9277473954
child 5 4d55b551dc57
--- a/TIFFRdr.st	Wed Oct 13 01:31:41 1993 +0100
+++ b/TIFFRdr.st	Wed Oct 13 01:32:33 1993 +0100
@@ -36,22 +36,52 @@
 
 documentation
 "
-    This class knows how to read TIFF files (and will
-    learn sometime in the future how to write them).
-    Currently, not all formats are implemented and of
-    those that are, not all are tested.
+    This class knows how to read TIFF files and how to
+    write uncompressed TIFF files.
+    Only single image files are supported.
+    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; 
-    JPEG is currently not implemented.
-    More formats and compressions will come ...
+    It supports reading of uncompressed, LZW and G3 compressed 
+    images; JPEG and pacbits are currently not implemented.
+    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 }"
@@ -84,6 +114,8 @@
         ]
     ].
 
+    inStream binary.
+
     version := self readShort.
     (version ~~ 42) ifTrue:[
         'version of tiff-file not supported' printNewline.
@@ -110,12 +142,11 @@
     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
-                    length:length
+        self decodeTiffTag:tagType numberType:numberType length:length
     ].
 
     offset := self readLong.
@@ -123,6 +154,7 @@
         'more tags ignored' printNewline
     ].
 
+    "check for required tags"
     ok := true.
     width isNil ifTrue:[
         'missing width tag' printNewline.
@@ -178,7 +210,7 @@
                   (compression == 32865) ifTrue:[
                     result := self readJPEGTiffImageData
                   ] ifFalse:[
-                    'compression type not known' printNewline
+                    'compression type ' , compression printString , ' not known' printNewline
                   ] 
               ] 
             ] 
@@ -194,7 +226,7 @@
 !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|
 
@@ -204,7 +236,12 @@
         ^ nil
     ].
 
+    "save as msb"
+
     byteOrder := #msb.
+"
+    byteOrder := #lsb.
+"
     fillOrder := #msb.
     width := image width.
     height := image height.
@@ -216,21 +253,25 @@
     compression := 1.   "none"
     data := image bits.
 
-    "save as msb"
 
     currentOffset := 0.
 
-    outStream nextPut:$M.
-    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"
@@ -243,19 +284,20 @@
         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"
@@ -268,9 +310,7 @@
     photometric == #palette ifTrue:[
         self writeTag:320            "colorMap"
     ].
-    self writeLong:0.
-
-    outStream close
+    self writeLong:0.                "end of tags mark"
 ! !
 
 !TIFFReader methodsFor:'private'!
@@ -280,13 +320,13 @@
 
     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
     ].
@@ -304,9 +344,9 @@
 
     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
         ]
@@ -315,7 +355,7 @@
         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
     ].
@@ -706,7 +746,7 @@
         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
@@ -720,15 +760,21 @@
     colorMap do:[:subMap |
         subMap do:[:entry |
             "my maps are 8 bit - tiff map is 16 bit"
-
-            self writeShort:(entry / 255 * 16rFFFF) rounded
+            entry isNil ifTrue:[
+                "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
@@ -736,8 +782,10 @@
 !
 
 writeStripByteCounts
+"
 'stripByteCounts: ' print. stripByteCounts printNewline.
 'store stripbytecounts at: ' print. outStream position printNewline.
+"
     stripByteCountsPos := outStream position.
     stripByteCounts do:[:c |
         self writeShort:c
@@ -745,8 +793,10 @@
 !
 
 writeBitsPerSample
+"
 'bitsPerSample: ' print. bitsPerSample printNewline.
 'store bitspersample at: ' print. outStream position printNewline.
+"
     bitsPerSamplePos := outStream position.
     bitsPerSample do:[:n |
         self writeShort:n
@@ -1175,7 +1225,7 @@
     ].
 
     (predictor == 2) ifTrue:[
-	self class decodeDelta:3 in:data width:width height:height
+        self class decodeDelta:3 in:data width:width height:height
     ]
 !
 
@@ -1216,7 +1266,7 @@
         bytesPerRow := bytesPerRow + 1
     ].
 
-    data := ByteArray uninitializedNew:(bytesPerRow * height).
+    data := ByteArray new:(bytesPerRow * height).
     compressedStrip := ByteArray uninitializedNew:bytesPerRow.
 
     offset := 1.
@@ -1227,8 +1277,7 @@
     [row <= height] whileTrue:[
         stripNr := stripNr + 1.
         inStream position:((stripOffsets at:stripNr) + 1).
-        inStream nextBytes:(stripByteCounts at:stripNr)
-                      into:compressedStrip.
+        inStream nextBytes:(stripByteCounts at:stripNr) into:compressedStrip.
         self class decompressCCITT3From:compressedStrip
                                    into:data
                              startingAt:offset