hg/stx-libview: comparison Image.st

equal deleted inserted replaced

-:612c17181395
+:0986d91407d9
 self bytesPerRowForWidth:15 depth:1 padding:32
 "
 !
 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
 "Modified: 20.4.1996 / 23:40:41 / cg"
 "Created: 10.6.1996 / 18:08:12 / cg"
 "Created: 1.2.1996 / 15:09:25 / cg"
 "Modified: 8.6.1996 / 09:54:02 / cg"
 !
 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
 !
 samplesPerPixel
 !Image methodsFor:'dither helpers'!
 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 }"
 bytesPerMonoRow "{Class: SmallInteger }"
 monoBits greyValues
 bitCnt          "{Class: SmallInteger }"
 byte            "{Class: SmallInteger }"
 grey|
 self depth > 12 ifTrue:[
-	^ self floydSteinbergDitheredMonochromeBits
+^ self floydSteinbergDitheredMonochromeBits
 ].
 w := width.
 h := height.
 "/ use table-value in loop
 greyValues := self greyMapForRange:(255*1024).
 0 to:(h-1) do:[:y |
-	nextDst := dstIndex + bytesPerMonoRow.
+nextDst := dstIndex + bytesPerMonoRow.
-	byte := 0.
+byte := 0.
-	bitCnt := 8.
+bitCnt := 8.
-	t := errorArray.
+t := errorArray.
-	errorArray := errorArray1.
+errorArray := errorArray1.
-	errorArray1 := t.
+errorArray1 := t.
-	errorArray1 atAllPut:0.
+errorArray1 atAllPut:0.
-	self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
+self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
-	    |eP "{Class: SmallInteger }"
+|eP "{Class: SmallInteger }"
-	     eD
+eD
-	     eI "{Class: SmallInteger }"
+eI "{Class: SmallInteger }"
-	     xE "{Class: SmallInteger }"
+xE "{Class: SmallInteger }"
-	     xN "{Class: SmallInteger }" |
+xN "{Class: SmallInteger }" |
-	    "/ get the colors grey value [0 .. 1]
+"/ get the colors grey value [0 .. 1]
-	    grey := greyValues at:(pixel + 1).
+grey := greyValues at:(pixel + 1).
-	    "/ adjust error
+"/ adjust error
-	    xE := x + 2 + 1.
+xE := x + 2 + 1.
-	    grey := (grey + (errorArray at:xE)).
+grey := (grey + (errorArray at:xE)).
-	    byte := byte bitShift:1.
+byte := byte bitShift:1.
-	    grey > (127*1024) ifTrue:[
+grey > (127*1024) ifTrue:[
-		byte := byte bitOr:1.      "/ white
+byte := byte bitOr:1.      "/ white
-		e := grey - (255*1024)
+e := grey - (255*1024)
-	    ] ifFalse:[
+] ifFalse:[
-		e := grey                  "/ black
+e := grey                  "/ black
-	    ].
+].
-	    e ~= 0 ifTrue:[
+e ~= 0 ifTrue:[
-		"/ distribute the error:
+"/ distribute the error:
-		"/                  XX  8  4
+"/                  XX  8  4
-		"/             2  4  8  4  2
+"/             2  4  8  4  2
-		eD := e.
+eD := e.
-		eI := e // 32.
+eI := e // 32.
-		eP := eI * 8. eD := eD - eP.
+eP := eI * 8. eD := eD - eP.
-		xN := xE + 1.
+xN := xE + 1.
-		errorArray at:xN put:(errorArray at:xN) + eP.
+errorArray at:xN put:(errorArray at:xN) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		errorArray1 at:xE put:(errorArray1 at:xE) + eP.
+errorArray1 at:xE put:(errorArray1 at:xE) + eP.
-		eP := eI * 4. eD := eD - eP.
+eP := eI * 4. eD := eD - eP.
-		xN := xE + 2.
+xN := xE + 2.
-		errorArray at:xN put:(errorArray at:xN) + eP.
+errorArray at:xN put:(errorArray at:xN) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		xN := xE - 1.
+xN := xE - 1.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		xN := xE + 1.
+xN := xE + 1.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-		eP := eI * 2. eD := eD - eP.
+eP := eI * 2. eD := eD - eP.
-		xN := xE - 2.
+xN := xE - 2.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-		"/ eD := eD.
+"/ eD := eD.
-		xN := xE + 2.
+xN := xE + 2.
-		errorArray1 at:xN put:(errorArray1 at:xN) + eP.
+errorArray1 at:xN put:(errorArray1 at:xN) + eP.
-	    ].
+].
-	    bitCnt := bitCnt - 1.
+bitCnt := bitCnt - 1.
-	    bitCnt == 0 ifTrue:[
+bitCnt == 0 ifTrue:[
-		monoBits at:dstIndex put:byte.
+monoBits at:dstIndex put:byte.
-		dstIndex := dstIndex + 1.
+dstIndex := dstIndex + 1.
-		byte := 0.
+byte := 0.
-		bitCnt := 8.
+bitCnt := 8.
-	    ].
+].
-	].
+].
-	bitCnt ~~ 8 ifTrue:[
+bitCnt ~~ 8 ifTrue:[
-	    byte := byte bitShift:bitCnt.
+byte := byte bitShift:bitCnt.
-	    monoBits at:dstIndex put:byte.
+monoBits at:dstIndex put:byte.
-	].
+].
-	dstIndex := nextDst.
+dstIndex := nextDst.
 ].
 ^ monoBits
 "Created: 10.6.1996 / 12:18:20 / cg"
 ^ monoBits
 !
 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 }"
 bytesPerMonoRow "{Class: SmallInteger }"
 monoBits greyValues
 byte            "{Class: SmallInteger }"
 grey
 xE              "{Class: SmallInteger }" |
 self depth > 12 ifTrue:[
-	^ self floydSteinbergDitheredMonochromeBits
+^ self floydSteinbergDitheredMonochromeBits
 ].
 w := width.
 h := height.
 "/ use table-value in loop
 greyValues := self greyMapForRange:(255 * 1024).
 0 to:(h-1) do:[:y |
-	nextDst := dstIndex + bytesPerMonoRow.
+nextDst := dstIndex + bytesPerMonoRow.
-	byte := 0.
+byte := 0.
-	bitCnt := 8.
+bitCnt := 8.
-	t := errorArray.
+t := errorArray.
-	errorArray := errorArray1.
+errorArray := errorArray1.
-	errorArray1 := errorArray2.
+errorArray1 := errorArray2.
-	errorArray2 := errorArray3.
+errorArray2 := errorArray3.
-	errorArray3 := t.
+errorArray3 := t.
-	errorArray3 atAllPut:0.
+errorArray3 atAllPut:0.
-	self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
+self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
-	    |eP eD|
+|eP eD|
-	    "/ get the colors grey value [0 .. 1]
+"/ get the colors grey value [0 .. 1]
-	    grey := greyValues at:(pixel + 1).
+grey := greyValues at:(pixel + 1).
-	    "/ adjust error
+"/ adjust error
-	    xE := x + 3 + 1.
+xE := x + 3 + 1.
-	    grey := (grey + (errorArray at:xE)).
+grey := (grey + (errorArray at:xE)).
-	    byte := byte bitShift:1.
+byte := byte bitShift:1.
-	    grey > (127 * 1024) ifTrue:[
+grey > (127 * 1024) ifTrue:[
-		byte := byte bitOr:1.      "/ white
+byte := byte bitOr:1.      "/ white
-		e := grey - (255 * 1024)
+e := grey - (255 * 1024)
-	    ] ifFalse:[
+] ifFalse:[
-		e := grey                  "/ black
+e := grey                  "/ black
-	    ].
+].
-	    e ~= 0 ifTrue:[
+e ~= 0 ifTrue:[
-		"/ distribute the error:
+"/ distribute the error:
-		"/                  XX    32
+"/                  XX    32
-		"/         12    26    30    16
+"/         12    26    30    16
-		"/            12    26    12
+"/            12    26    12
-		"/          5    12    12     5
+"/          5    12    12     5
-		eD := e.
+eD := e.
-		e := e // 200.
+e := e // 200.
-		eP := e * 32. eD := eD - eP.
+eP := e * 32. eD := eD - eP.
-		errorArray at:xE+2 put:(errorArray at:xE+2) + eP.
+errorArray at:xE+2 put:(errorArray at:xE+2) + eP.
-		eP := e * 30. eD := eD - eP.
+eP := e * 30. eD := eD - eP.
-		errorArray1 at:xE+1 put:(errorArray1 at:xE+1) + eP.
+errorArray1 at:xE+1 put:(errorArray1 at:xE+1) + eP.
-		eP := e * 16. eD := eD - eP.
+eP := e * 16. eD := eD - eP.
-		errorArray1 at:xE+3 put:(errorArray1 at:xE+3) + eP.
+errorArray1 at:xE+3 put:(errorArray1 at:xE+3) + eP.
-		eP := e * 26. eD := eD - eP.
+eP := e * 26. eD := eD - eP.
-		errorArray1 at:xE-1 put:(errorArray1 at:xE-1) + eP.
+errorArray1 at:xE-1 put:(errorArray1 at:xE-1) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		errorArray2 at:xE put:(errorArray2 at:xE) + eP.
+errorArray2 at:xE put:(errorArray2 at:xE) + eP.
-		eP := e * 12. eD := eD - eP.
+eP := e * 12. eD := eD - eP.
-		errorArray1 at:xE-3 put:(errorArray1 at:xE-3) + eP.
+errorArray1 at:xE-3 put:(errorArray1 at:xE-3) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		errorArray2 at:xE-2 put:(errorArray2 at:xE-2) + eP.
+errorArray2 at:xE-2 put:(errorArray2 at:xE-2) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		errorArray2 at:xE+2 put:(errorArray2 at:xE+2) + eP.
+errorArray2 at:xE+2 put:(errorArray2 at:xE+2) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		errorArray3 at:xE-1 put:(errorArray3 at:xE-1) + eP.
+errorArray3 at:xE-1 put:(errorArray3 at:xE-1) + eP.
-		eD := eD - eP.
+eD := eD - eP.
-		errorArray3 at:xE+1 put:(errorArray3 at:xE+1) + eP.
+errorArray3 at:xE+1 put:(errorArray3 at:xE+1) + eP.
-		eP := e * 5. eD := eD - eP.
+eP := e * 5. eD := eD - eP.
-		errorArray3 at:xE-3 put:(errorArray3 at:xE-3) + eP.
+errorArray3 at:xE-3 put:(errorArray3 at:xE-3) + eP.
-		eP := eD.
+eP := eD.
-		errorArray3 at:xE+3 put:(errorArray3 at:xE+3) + eP.
+errorArray3 at:xE+3 put:(errorArray3 at:xE+3) + eP.
-	    ].
+].
-	    bitCnt := bitCnt - 1.
+bitCnt := bitCnt - 1.
-	    bitCnt == 0 ifTrue:[
+bitCnt == 0 ifTrue:[
-		monoBits at:dstIndex put:byte.
+monoBits at:dstIndex put:byte.
-		dstIndex := dstIndex + 1.
+dstIndex := dstIndex + 1.
-		byte := 0.
+byte := 0.
-		bitCnt := 8.
+bitCnt := 8.
-	    ].
+].
-	].
+].
-	bitCnt ~~ 8 ifTrue:[
+bitCnt ~~ 8 ifTrue:[
-	    byte := byte bitShift:bitCnt.
+byte := byte bitShift:bitCnt.
-	    monoBits at:dstIndex put:byte.
+monoBits at:dstIndex put:byte.
-	].
+].
-	dstIndex := nextDst.
+dstIndex := nextDst.
 ].
 ^ monoBits
 "Created: 10.6.1996 / 12:38:35 / cg"
 storeOn:aStream
 "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:' width:'. width storeOn:aStream.
-aStream nextPutAll:'; height: '. height storeOn:aStream.
+aStream nextPutAll:'; height:'. height storeOn:aStream.
-aStream nextPutAll:'; photometric:('. photometric storeOn:aStream.
-aStream nextPutAll:'); bitsPerSample:('. bitsPerSample storeOn:aStream.
+"/ avoiding some unneeded stuff here makes object files with many images a bit smaller.
-aStream nextPutAll:'); samplesPerPixel:('. samplesPerPixel storeOn:aStream.
+"/ 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:[
+self depth <= 8 ifTrue:[
-	    "/ cut off unused colors ...
+"/ cut off unused colors ...
-	    usedValues := self usedValues.
+usedValues := self usedValues.
-	    colors := colorMap copyFrom:1 to:((usedValues max+1) min:colorMap size).
+colors := colorMap copyFrom:1 to:((usedValues max+1) min:colorMap size).
-	    colorMapArray := OrderedCollection new.
+colorMapArray := OrderedCollection new.
-	    colors do:[:clr| colorMapArray add:(clr redByte); add:(clr greenByte); add:(clr blueByte)].
+colors do:[:clr| colorMapArray add:(clr redByte); add:(clr greenByte); add:(clr blueByte)].
-	    aStream nextPutAll:'; colorMapFromArray:'.
+aStream nextPutAll:'; colorMapFromArray:'.
-	    colorMapArray asByteArray storeOn:aStream.
+colorMapArray asByteArray storeOn:aStream.
-	] ifFalse:[
+] ifFalse:[
-	    aStream nextPutAll:'; colorMap:('.
+aStream nextPutAll:'; colorMap:('.
-	    colorMap storeOn:aStream.
+colorMap storeOn:aStream.
-	    aStream nextPutAll:')'
+aStream nextPutAll:')'
-	]
+]
 ].
 mask notNil ifTrue:[
-	aStream nextPutAll:'; mask:('.
+aStream nextPutAll:'; mask:('.
-	mask storeOn:aStream.
+mask storeOn:aStream.
-	aStream nextPutAll:')'.
+aStream nextPutAll:')'.
 ].
 aStream nextPutAll:'; yourself'
 "Modified: / 22.8.1998 / 12:55:21 / cg"
 ! !
 ! !
 !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 $'
 ! !
 Image initialize!

changeset 6311	0986d91407d9
parent 6308	6e4008b97f64
child 6370	9e3a18c732ca