Image.st
changeset 6311 0986d91407d9
parent 6308 6e4008b97f64
child 6370 9e3a18c732ca
--- a/Image.st	Wed Mar 05 16:26:38 2014 +0100
+++ b/Image.st	Wed Mar 05 16:58:09 2014 +0100
@@ -1926,7 +1926,11 @@
 !
 
 defaultPhotometric
-    "return the default photometric pixel interpretation"
+    "return the default photometric pixel interpretation.
+     This may be a somewhat old leftover from times, when tiff was the first image file type to be read.
+     Much better would be to always have some (possibly fake and virtual) colormap around, and ask that one.
+     However, in the meantime, many other classes depend on that, so that it should be kept as an API 
+     - even when the internal representation will be replaced by something better in the future."
 
     ^ #blackIs0
 
@@ -2692,7 +2696,12 @@
 !
 
 photometric
-    "return the photometric, a symbol such as #palette, #rgb etc."
+    "return the photometric, a symbol such as #palette, #rgb etc.
+     This may be a somewhat old leftover from times, when tiff was the first image file type to be read.
+     Much better would be to always have some (possibly fake and virtual) colormap around, and ask that one.
+     However, in the meantime, many other classes depend on that, so that it should be kept as an API 
+     - even when the internal representation will be replaced by something better in the future."
+
 
     ^ photometric
 !
@@ -6417,7 +6426,8 @@
 
 burkesDitheredMonochromeBits
     "return the bitmap for a dithered monochrome bitmap from the image.
-     Works for any source depths / photometric"
+     Works for any source depths / photometric.
+     TODO: move to separate dither helper class"
 
     |dstIndex        "{Class: SmallInteger }"
      nextDst         "{Class: SmallInteger }"
@@ -6433,7 +6443,7 @@
      grey|
 
     self depth > 12 ifTrue:[
-	^ self floydSteinbergDitheredMonochromeBits
+        ^ self floydSteinbergDitheredMonochromeBits
     ].
 
     w := width.
@@ -6453,90 +6463,90 @@
     greyValues := self greyMapForRange:(255*1024).
 
     0 to:(h-1) do:[:y |
-	nextDst := dstIndex + bytesPerMonoRow.
-	byte := 0.
-	bitCnt := 8.
-
-	t := errorArray.
-	errorArray := errorArray1.
-	errorArray1 := t.
-
-	errorArray1 atAllPut:0.
-
-	self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
-	    |eP "{Class: SmallInteger }"
-	     eD
-	     eI "{Class: SmallInteger }"
-	     xE "{Class: SmallInteger }"
-	     xN "{Class: SmallInteger }" |
-
-	    "/ get the colors grey value [0 .. 1]
-	    grey := greyValues at:(pixel + 1).
-
-	    "/ adjust error
-	    xE := x + 2 + 1.
-	    grey := (grey + (errorArray at:xE)).
-
-	    byte := byte bitShift:1.
-	    grey > (127*1024) ifTrue:[
-		byte := byte bitOr:1.      "/ white
-		e := grey - (255*1024)
-	    ] ifFalse:[
-		e := grey                  "/ black
-	    ].
-
-	    e ~= 0 ifTrue:[
-		"/ distribute the error:
-		"/                  XX  8  4
-		"/             2  4  8  4  2
-
-		eD := e.
-		eI := e // 32.
-
-		eP := eI * 8. eD := eD - eP.
-
-		xN := xE + 1.
-		errorArray at:xN put:(errorArray at:xN) + eP.
-
-		eD := eD - eP.
-		errorArray1 at:xE put:(errorArray1 at:xE) + eP.
-
-		eP := eI * 4. eD := eD - eP.
-		xN := xE + 2.
-		errorArray at:xN put:(errorArray at:xN) + eP.
-
-		eD := eD - eP.
-		xN := xE - 1.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-
-		eD := eD - eP.
-		xN := xE + 1.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-
-		eP := eI * 2. eD := eD - eP.
-		xN := xE - 2.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-
-		"/ eD := eD.
-		xN := xE + 2.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-	    ].
-
-	    bitCnt := bitCnt - 1.
-	    bitCnt == 0 ifTrue:[
-		monoBits at:dstIndex put:byte.
-		dstIndex := dstIndex + 1.
-		byte := 0.
-		bitCnt := 8.
-	    ].
-
-	].
-	bitCnt ~~ 8 ifTrue:[
-	    byte := byte bitShift:bitCnt.
-	    monoBits at:dstIndex put:byte.
-	].
-
-	dstIndex := nextDst.
+        nextDst := dstIndex + bytesPerMonoRow.
+        byte := 0.
+        bitCnt := 8.
+
+        t := errorArray.
+        errorArray := errorArray1.
+        errorArray1 := t.
+
+        errorArray1 atAllPut:0.
+
+        self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
+            |eP "{Class: SmallInteger }"
+             eD
+             eI "{Class: SmallInteger }"
+             xE "{Class: SmallInteger }"
+             xN "{Class: SmallInteger }" |
+
+            "/ get the colors grey value [0 .. 1]
+            grey := greyValues at:(pixel + 1).
+
+            "/ adjust error
+            xE := x + 2 + 1.
+            grey := (grey + (errorArray at:xE)).
+
+            byte := byte bitShift:1.
+            grey > (127*1024) ifTrue:[
+                byte := byte bitOr:1.      "/ white
+                e := grey - (255*1024)
+            ] ifFalse:[
+                e := grey                  "/ black
+            ].
+
+            e ~= 0 ifTrue:[
+                "/ distribute the error:
+                "/                  XX  8  4
+                "/             2  4  8  4  2
+
+                eD := e.
+                eI := e // 32.
+
+                eP := eI * 8. eD := eD - eP.
+
+                xN := xE + 1.
+                errorArray at:xN put:(errorArray at:xN) + eP.
+
+                eD := eD - eP.
+                errorArray1 at:xE put:(errorArray1 at:xE) + eP.
+
+                eP := eI * 4. eD := eD - eP.
+                xN := xE + 2.
+                errorArray at:xN put:(errorArray at:xN) + eP.
+
+                eD := eD - eP.
+                xN := xE - 1.
+                errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+
+                eD := eD - eP.
+                xN := xE + 1.
+                errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+
+                eP := eI * 2. eD := eD - eP.
+                xN := xE - 2.
+                errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+
+                "/ eD := eD.
+                xN := xE + 2.
+                errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+            ].
+
+            bitCnt := bitCnt - 1.
+            bitCnt == 0 ifTrue:[
+                monoBits at:dstIndex put:byte.
+                dstIndex := dstIndex + 1.
+                byte := 0.
+                bitCnt := 8.
+            ].
+
+        ].
+        bitCnt ~~ 8 ifTrue:[
+            byte := byte bitShift:bitCnt.
+            monoBits at:dstIndex put:byte.
+        ].
+
+        dstIndex := nextDst.
     ].
 
     ^ monoBits
@@ -8684,7 +8694,8 @@
 
 stevensonArceDitheredMonochromeBits
     "return the bitmap for a dithered monochrome bitmap from the image.
-     Works for any source depths / photometric"
+     Works for any source depths / photometric.
+     TODO: move to separate dither helper class"
 
     |dstIndex        "{Class: SmallInteger }"
      nextDst         "{Class: SmallInteger }"
@@ -8701,7 +8712,7 @@
      xE              "{Class: SmallInteger }" |
 
     self depth > 12 ifTrue:[
-	^ self floydSteinbergDitheredMonochromeBits
+        ^ self floydSteinbergDitheredMonochromeBits
     ].
 
     w := width.
@@ -8723,98 +8734,98 @@
     greyValues := self greyMapForRange:(255 * 1024).
 
     0 to:(h-1) do:[:y |
-	nextDst := dstIndex + bytesPerMonoRow.
-	byte := 0.
-	bitCnt := 8.
-
-	t := errorArray.
-	errorArray := errorArray1.
-	errorArray1 := errorArray2.
-	errorArray2 := errorArray3.
-	errorArray3 := t.
-
-	errorArray3 atAllPut:0.
-
-	self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
-	    |eP eD|
-
-	    "/ get the colors grey value [0 .. 1]
-	    grey := greyValues at:(pixel + 1).
-
-	    "/ adjust error
-	    xE := x + 3 + 1.
-	    grey := (grey + (errorArray at:xE)).
-
-	    byte := byte bitShift:1.
-	    grey > (127 * 1024) ifTrue:[
-		byte := byte bitOr:1.      "/ white
-		e := grey - (255 * 1024)
-	    ] ifFalse:[
-		e := grey                  "/ black
-	    ].
-
-	    e ~= 0 ifTrue:[
-		"/ distribute the error:
-		"/                  XX    32
-		"/         12    26    30    16
-		"/            12    26    12
-		"/          5    12    12     5
-
-		eD := e.
-		e := e // 200.
-
-		eP := e * 32. eD := eD - eP.
-		errorArray at:xE+2 put:(errorArray at:xE+2) + eP.
-
-		eP := e * 30. eD := eD - eP.
-		errorArray1 at:xE+1 put:(errorArray1 at:xE+1) + eP.
-
-		eP := e * 16. eD := eD - eP.
-		errorArray1 at:xE+3 put:(errorArray1 at:xE+3) + eP.
-
-		eP := e * 26. eD := eD - eP.
-		errorArray1 at:xE-1 put:(errorArray1 at:xE-1) + eP.
-
-		eD := eD - eP.
-		errorArray2 at:xE put:(errorArray2 at:xE) + eP.
-
-		eP := e * 12. eD := eD - eP.
-		errorArray1 at:xE-3 put:(errorArray1 at:xE-3) + eP.
-
-		eD := eD - eP.
-		errorArray2 at:xE-2 put:(errorArray2 at:xE-2) + eP.
-
-		eD := eD - eP.
-		errorArray2 at:xE+2 put:(errorArray2 at:xE+2) + eP.
-
-		eD := eD - eP.
-		errorArray3 at:xE-1 put:(errorArray3 at:xE-1) + eP.
-
-		eD := eD - eP.
-		errorArray3 at:xE+1 put:(errorArray3 at:xE+1) + eP.
-
-		eP := e * 5. eD := eD - eP.
-		errorArray3 at:xE-3 put:(errorArray3 at:xE-3) + eP.
-
-		eP := eD.
-		errorArray3 at:xE+3 put:(errorArray3 at:xE+3) + eP.
-	    ].
-
-	    bitCnt := bitCnt - 1.
-	    bitCnt == 0 ifTrue:[
-		monoBits at:dstIndex put:byte.
-		dstIndex := dstIndex + 1.
-		byte := 0.
-		bitCnt := 8.
-	    ].
-
-	].
-	bitCnt ~~ 8 ifTrue:[
-	    byte := byte bitShift:bitCnt.
-	    monoBits at:dstIndex put:byte.
-	].
-
-	dstIndex := nextDst.
+        nextDst := dstIndex + bytesPerMonoRow.
+        byte := 0.
+        bitCnt := 8.
+
+        t := errorArray.
+        errorArray := errorArray1.
+        errorArray1 := errorArray2.
+        errorArray2 := errorArray3.
+        errorArray3 := t.
+
+        errorArray3 atAllPut:0.
+
+        self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
+            |eP eD|
+
+            "/ get the colors grey value [0 .. 1]
+            grey := greyValues at:(pixel + 1).
+
+            "/ adjust error
+            xE := x + 3 + 1.
+            grey := (grey + (errorArray at:xE)).
+
+            byte := byte bitShift:1.
+            grey > (127 * 1024) ifTrue:[
+                byte := byte bitOr:1.      "/ white
+                e := grey - (255 * 1024)
+            ] ifFalse:[
+                e := grey                  "/ black
+            ].
+
+            e ~= 0 ifTrue:[
+                "/ distribute the error:
+                "/                  XX    32
+                "/         12    26    30    16
+                "/            12    26    12
+                "/          5    12    12     5
+
+                eD := e.
+                e := e // 200.
+
+                eP := e * 32. eD := eD - eP.
+                errorArray at:xE+2 put:(errorArray at:xE+2) + eP.
+
+                eP := e * 30. eD := eD - eP.
+                errorArray1 at:xE+1 put:(errorArray1 at:xE+1) + eP.
+
+                eP := e * 16. eD := eD - eP.
+                errorArray1 at:xE+3 put:(errorArray1 at:xE+3) + eP.
+
+                eP := e * 26. eD := eD - eP.
+                errorArray1 at:xE-1 put:(errorArray1 at:xE-1) + eP.
+
+                eD := eD - eP.
+                errorArray2 at:xE put:(errorArray2 at:xE) + eP.
+
+                eP := e * 12. eD := eD - eP.
+                errorArray1 at:xE-3 put:(errorArray1 at:xE-3) + eP.
+
+                eD := eD - eP.
+                errorArray2 at:xE-2 put:(errorArray2 at:xE-2) + eP.
+
+                eD := eD - eP.
+                errorArray2 at:xE+2 put:(errorArray2 at:xE+2) + eP.
+
+                eD := eD - eP.
+                errorArray3 at:xE-1 put:(errorArray3 at:xE-1) + eP.
+
+                eD := eD - eP.
+                errorArray3 at:xE+1 put:(errorArray3 at:xE+1) + eP.
+
+                eP := e * 5. eD := eD - eP.
+                errorArray3 at:xE-3 put:(errorArray3 at:xE-3) + eP.
+
+                eP := eD.
+                errorArray3 at:xE+3 put:(errorArray3 at:xE+3) + eP.
+            ].
+
+            bitCnt := bitCnt - 1.
+            bitCnt == 0 ifTrue:[
+                monoBits at:dstIndex put:byte.
+                dstIndex := dstIndex + 1.
+                byte := 0.
+                bitCnt := 8.
+            ].
+
+        ].
+        bitCnt ~~ 8 ifTrue:[
+            byte := byte bitShift:bitCnt.
+            monoBits at:dstIndex put:byte.
+        ].
+
+        dstIndex := nextDst.
     ].
 
     ^ monoBits
@@ -12178,42 +12189,67 @@
     "append a printed representation of the receiver to aStream,
      from which a copy of it can be reconstructed."
 
-    |colors usedValues colorMapArray|
+    |colors usedValues colorMapArray needBPS|
 
     aStream nextPutAll:'(' , self class name , ' new)'.
-    aStream nextPutAll:' width: '. width storeOn:aStream.
-    aStream nextPutAll:'; height: '. height storeOn:aStream.
-    aStream nextPutAll:'; photometric:('. photometric storeOn:aStream.
-    aStream nextPutAll:'); bitsPerSample:('. bitsPerSample storeOn:aStream.
-    aStream nextPutAll:'); samplesPerPixel:('. samplesPerPixel storeOn:aStream.
+    aStream nextPutAll:' width:'. width storeOn:aStream.
+    aStream nextPutAll:'; height:'. height storeOn:aStream.
+
+    "/ avoiding some unneeded stuff here makes object files with many images a bit smaller.
+    "/ no need for the photometric, if its the default anyway
+    photometric ~= self class defaultPhotometric ifTrue:[
+        (colorMap isNil or:[photometric ~~ #palette]) ifTrue:[
+            aStream nextPutAll:'; photometric:('. photometric storeOn:aStream. aStream nextPutAll:')'.
+        ].
+    ].
+
+    "/ no need to store bitPerSample/samplesPerPixel in all situations
+    needBPS := true.
+
+    self depth == 1 
+        ifTrue:[ needBPS := false ]
+        ifFalse:[
+            ((photometric == #palette) 
+                and:[ (bitsPerSample size == 1)
+                and:[ ((bitsPerSample at:1) == self depth)
+                and:[ samplesPerPixel == 1 ]]])
+            ifTrue:[
+                needBPS := false.
+            ].
+        ].
+
+    needBPS ifTrue:[
+        aStream nextPutAll:'; bitsPerSample:('. bitsPerSample storeOn:aStream. aStream nextPutAll:')'.
+        aStream nextPutAll:'; samplesPerPixel:('. samplesPerPixel storeOn:aStream. aStream nextPutAll:')'. 
+    ].
 
     "/ assert that all bits are there...
     "/ self assert:(self bits size) >= (self bytesPerRow * height).
     "/ self bits:((ByteArray new:self bytesPerRow * height) replaceFrom:1 with:self bits).
 
-    aStream nextPutAll:'); bits:(ByteArray fromPackedString:'. self bits asPackedString storeOn:aStream.
+    aStream nextPutAll:'; bits:(ByteArray fromPackedString:'. self bits asPackedString storeOn:aStream.
     aStream nextPutAll:') '.
 
     colorMap notNil ifTrue:[
-	self depth <= 8 ifTrue:[
-	    "/ cut off unused colors ...
-	    usedValues := self usedValues.
-	    colors := colorMap copyFrom:1 to:((usedValues max+1) min:colorMap size).
-
-	    colorMapArray := OrderedCollection new.
-	    colors do:[:clr| colorMapArray add:(clr redByte); add:(clr greenByte); add:(clr blueByte)].
-	    aStream nextPutAll:'; colorMapFromArray:'.
-	    colorMapArray asByteArray storeOn:aStream.
-	] ifFalse:[
-	    aStream nextPutAll:'; colorMap:('.
-	    colorMap storeOn:aStream.
-	    aStream nextPutAll:')'
-	]
+        self depth <= 8 ifTrue:[
+            "/ cut off unused colors ...
+            usedValues := self usedValues.
+            colors := colorMap copyFrom:1 to:((usedValues max+1) min:colorMap size).
+
+            colorMapArray := OrderedCollection new.
+            colors do:[:clr| colorMapArray add:(clr redByte); add:(clr greenByte); add:(clr blueByte)].
+            aStream nextPutAll:'; colorMapFromArray:'.
+            colorMapArray asByteArray storeOn:aStream.
+        ] ifFalse:[
+            aStream nextPutAll:'; colorMap:('.
+            colorMap storeOn:aStream.
+            aStream nextPutAll:')'
+        ]
     ].
     mask notNil ifTrue:[
-	aStream nextPutAll:'; mask:('.
-	mask storeOn:aStream.
-	aStream nextPutAll:')'.
+        aStream nextPutAll:'; mask:('.
+        mask storeOn:aStream.
+        aStream nextPutAll:')'.
     ].
     aStream nextPutAll:'; yourself'
 
@@ -14387,11 +14423,11 @@
 !Image class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.449 2014-03-04 22:20:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.450 2014-03-05 15:58:09 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.449 2014-03-04 22:20:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.450 2014-03-05 15:58:09 cg Exp $'
 ! !