hg/stx-libview: comparison Depth8Image.st

equal deleted inserted replaced

-:ef80a2590a84
+:717a41ef31e4
 m          "{Class: SmallInteger }"
 mapSize    "{Class: SmallInteger }"
 cube nR nG nB ditherColors clr|
 (cube := aDevice fixColors) notNil ifTrue:[
-	nR := aDevice numFixRed.
+nR := aDevice numFixRed.
-	nG := aDevice numFixGreen.
+nG := aDevice numFixGreen.
-	nB := aDevice numFixBlue.
+nB := aDevice numFixBlue.
-	DitherAlgorithm == #floydSteinberg ifTrue:[
+DitherAlgorithm == #floydSteinberg ifTrue:[
-	    f := self
+f := self
-		   asFloydSteinbergDitheredDepth8FormOn:aDevice
+asFloydSteinbergDitheredDepth8FormOn:aDevice
-		   colors:cube
+colors:cube
-		   nRed:nR
+nRed:nR
-		   nGreen:nG
+nGreen:nG
-		   nBlue:nB.
+nBlue:nB.
-	] ifFalse:[
+] ifFalse:[
-	    f := self
+f := self
-		   asNearestPaintDepth8FormOn:aDevice
+asNearestPaintDepth8FormOn:aDevice
-		   colors:cube
+colors:cube
-		   nRed:nR
+nRed:nR
-		   nGreen:nG
+nGreen:nG
-		   nBlue:nB.
+nBlue:nB.
-	].
+].
-	f notNil ifTrue:[^ f].
+f notNil ifTrue:[^ f].
 ].
 "find used colors"
 bytes := self bits.
 usedColors := bytes usedValues.    "gets us an array filled with used values"
-				       "(could use bytes asBag)"
+"(could use bytes asBag)"
 maxIndex := usedColors max + 1.
 usedColors size > 20 ifTrue:[
-	('Depth8Image [info]: allocating ' , usedColors size printString , ' colors ...') infoPrintCR.
+('Depth8Image [info]: allocating ' , usedColors size printString , ' colors ...') infoPrintCR.
 ].
 "sort by usage"
 usageCounts := bytes usageCounts.
 usageCounts := usedColors asArray collect:[:clr | usageCounts at:(clr + 1)].
 scale := 100.0 / div.       "to scale 0..255 into 0.0 .. 100.0"
 lastOK := 0.
 gcRound := 0.
 usedColors do:[:aColorIndex |
-	|devColor color
+|devColor color
-	 r        "{Class: SmallInteger }"
+r        "{Class: SmallInteger }"
-	 g        "{Class: SmallInteger }"
+g        "{Class: SmallInteger }"
-	 b        "{Class: SmallInteger }"
+b        "{Class: SmallInteger }"
-	 mapIndex "{Class: SmallInteger }"|
+mapIndex "{Class: SmallInteger }"|
-	fit ifTrue:[
+fit ifTrue:[
-	    mapIndex := aColorIndex + 1.
+mapIndex := aColorIndex + 1.
-	    "/ color := colorMap at:mapIndex.
+"/ color := colorMap at:mapIndex.
-	    color := self colorFromValue:aColorIndex.
+color := self colorFromValue:aColorIndex.
-	    (color isOnDevice:aDevice) ifTrue:[
+(color isOnDevice:aDevice) ifTrue:[
-		"wow - an immediate hit"
+"wow - an immediate hit"
-		devColor := color
+devColor := color
-	    ] ifFalse:[
+] ifFalse:[
-		devColor := color exactOn:aDevice.
+devColor := color exactOn:aDevice.
-		devColor isNil ifTrue:[
+devColor isNil ifTrue:[
-		    "
+"
-		     could not allocate color - on the first round, do a GC to flush
+could not allocate color - on the first round, do a GC to flush
-		     unused colors - this may help if some colors where locked by
+unused colors - this may help if some colors where locked by
-		     already free images.
+already free images.
-		    "
+"
-		    gcRound == 0 ifTrue:[
+gcRound == 0 ifTrue:[
-			ObjectMemory scavenge; finalize.
+ObjectMemory scavenge; finalize.
-			devColor := color exactOn:aDevice.
+devColor := color exactOn:aDevice.
-			gcRound := 1
+gcRound := 1
-		    ].
+].
-		    devColor isNil ifTrue:[
+devColor isNil ifTrue:[
-			gcRound == 1 ifTrue:[
+gcRound == 1 ifTrue:[
-			    CollectGarbageWhenRunningOutOfColors ifTrue:[
+CollectGarbageWhenRunningOutOfColors ifTrue:[
-				'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR.
+'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR.
-				ObjectMemory incrementalGC; finalize.
+ObjectMemory incrementalGC; finalize.
-				devColor := color exactOn:aDevice.
+devColor := color exactOn:aDevice.
-			    ].
+].
-			    gcRound := 2
+gcRound := 2
-			]
+]
-		    ]
+]
-		].
+].
-	    ].
+].
-	    (devColor notNil and:[devColor colorId notNil]) ifTrue:[
+(devColor notNil and:[devColor colorId notNil]) ifTrue:[
-		imgMap at:mapIndex put:devColor.
+imgMap at:mapIndex put:devColor.
-		lastOK := lastOK + 1.
+lastOK := lastOK + 1.
-	    ] ifFalse:[
+] ifFalse:[
-		fit := false
+fit := false
-	    ]
+]
-	]
+]
 ].
 fit ifFalse:[
-	('Depth8Image [info]: got %1 exact colors (out of %2)' bindWith:lastOK with:usedColors size) infoPrintCR.
+('Depth8Image [info]: got %1 exact colors (out of %2)' bindWith:lastOK with:usedColors size) infoPrintCR.
-	DitherAlgorithm == #floydSteinberg ifTrue:[
+DitherAlgorithm == #floydSteinberg ifTrue:[
-	    dColors := imgMap collect:[:clr | clr isNil ifTrue:[clr]
+dColors := imgMap collect:[:clr | clr isNil ifTrue:[clr]
-							ifFalse:[clr nearestOn:aDevice]].
+ifFalse:[clr nearestOn:aDevice]].
-	    dColors := dColors select:[:clr | clr notNil].
+dColors := dColors select:[:clr | clr notNil].
-	    dColors := dColors collect:[:clr | clr exactOn:aDevice].
+dColors := dColors collect:[:clr | clr exactOn:aDevice].
-	    dColors := dColors select:[:clr | clr notNil].
+dColors := dColors select:[:clr | clr notNil].
-	    dColors := dColors asSet.
+dColors := dColors asSet.
-	    dColors addAll:((aDevice colorMap collect:[:c|c onDevice:aDevice])
+dColors addAll:((aDevice colorMap collect:[:c|c onDevice:aDevice])
-			    select:[:c | c colorId notNil]).
+select:[:c | c colorId notNil]).
-	    ditherColors := aDevice availableDitherColors.
+ditherColors := aDevice availableDitherColors.
-	    ditherColors notNil ifTrue:[
+ditherColors notNil ifTrue:[
-		dColors addAll:ditherColors.
+dColors addAll:ditherColors.
-	    ].
+].
-	    dColors := dColors asArray.
+dColors := dColors asArray.
-	    dColors size > 256 ifTrue:[
+dColors size > 256 ifTrue:[
-		dColors := dColors copyTo:256
+dColors := dColors copyTo:256
-	    ].
+].
-	    ^ self asFloydSteinbergDitheredPseudoFormUsing:dColors on:aDevice
+^ self asFloydSteinbergDitheredPseudoFormUsing:dColors on:aDevice
-	].
+].
-	"
+"
-	 again, this time allow wrong colors (loop while increasing allowed error)
+again, this time allow wrong colors (loop while increasing allowed error)
-	"
+"
-	error := 1.
+error := 1.
-	[fit] whileFalse:[
+[fit] whileFalse:[
-	    fit := true.
+fit := true.
-	    usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
+usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
-		|devColor color
+|devColor color
-		 r        "{Class: SmallInteger }"
+r        "{Class: SmallInteger }"
-		 g        "{Class: SmallInteger }"
+g        "{Class: SmallInteger }"
-		 b        "{Class: SmallInteger }"
+b        "{Class: SmallInteger }"
-		 mapIndex "{Class: SmallInteger }"
+mapIndex "{Class: SmallInteger }"
-		 rMask    "{Class: SmallInteger }"
+rMask    "{Class: SmallInteger }"
-		 gMask    "{Class: SmallInteger }"
+gMask    "{Class: SmallInteger }"
-		 bMask    "{Class: SmallInteger }"|
+bMask    "{Class: SmallInteger }"|
-		fit ifTrue:[
+fit ifTrue:[
-		    gMask := bMask := rMask := m.
+gMask := bMask := rMask := m.
-		    mapIndex := aColorIndex + 1.
+mapIndex := aColorIndex + 1.
-		    "/ color := colorMap at:mapIndex.
+"/ color := colorMap at:mapIndex.
-		    color := self colorFromValue:aColorIndex.
+color := self colorFromValue:aColorIndex.
-		    r := (color red * 255 / 100.0) rounded.
+r := (color red * 255 / 100.0) rounded.
-		    g := (color green * 255 / 100.0) rounded.
+g := (color green * 255 / 100.0) rounded.
-		    b := (color blue * 255 / 100.0) rounded.
+b := (color blue * 255 / 100.0) rounded.
-		    color := Color red:((r bitShift:shift) bitAnd:rMask) * scale
+color := Color red:((r bitShift:shift) bitAnd:rMask) * scale
-				 green:((g bitShift:shift) bitAnd:gMask) * scale
+green:((g bitShift:shift) bitAnd:gMask) * scale
-				  blue:((b bitShift:shift) bitAnd:bMask) * scale.
+blue:((b bitShift:shift) bitAnd:bMask) * scale.
-		    (color isOnDevice:aDevice) ifTrue:[
+(color isOnDevice:aDevice) ifTrue:[
-			"wow - an immediate hit"
+"wow - an immediate hit"
-			devColor := color.
+devColor := color.
-		    ] ifFalse:[
+] ifFalse:[
-			devColor := color nearestOn:aDevice.
+devColor := color nearestOn:aDevice.
-			(devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[
+(devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[
-			    devColor := nil
+devColor := nil
-			].
+].
-			devColor isNil ifTrue:[
+devColor isNil ifTrue:[
-			    "
+"
-			     no free color - on the first round, do a GC to flush unused
+no free color - on the first round, do a GC to flush unused
-			     colors - this may help if some colors where locked by already
+colors - this may help if some colors where locked by already
-			     free images.
+free images.
-			    "
+"
-			    gcRound == 0 ifTrue:[
+gcRound == 0 ifTrue:[
-				ObjectMemory scavenge; finalize.
+ObjectMemory scavenge; finalize.
-				devColor := color nearestOn:aDevice.
+devColor := color nearestOn:aDevice.
-				(devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[
+(devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[
-				    devColor := nil
+devColor := nil
-				].
+].
-				gcRound := 1
+gcRound := 1
-			    ].
+].
-			    devColor isNil ifTrue:[
+devColor isNil ifTrue:[
-				gcRound == 1 ifTrue:[
+gcRound == 1 ifTrue:[
-				    CollectGarbageWhenRunningOutOfColors ifTrue:[
+CollectGarbageWhenRunningOutOfColors ifTrue:[
-					'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR.
+'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR.
-					ObjectMemory incrementalGC; finalize.
+ObjectMemory incrementalGC; finalize.
-					devColor := color nearestOn:aDevice.
+devColor := color nearestOn:aDevice.
-					(devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[
+(devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[
-					    devColor := nil
+devColor := nil
-					].
+].
-				    ].
+].
-				    gcRound := 2
+gcRound := 2
-				]
+]
-			    ]
+]
-			].
+].
-		    ].
+].
-		    (devColor notNil and:[devColor colorId notNil]) ifTrue:[
+(devColor notNil and:[devColor colorId notNil]) ifTrue:[
-			imgMap at:mapIndex put:devColor.
+imgMap at:mapIndex put:devColor.
-			lastOK := lastOK + 1.
+lastOK := lastOK + 1.
-		    ] ifFalse:[
+] ifFalse:[
-			fit := false
+fit := false
-		    ]
+]
-		].
+].
-	    ].
+].
-	    fit ifTrue:[
+fit ifTrue:[
-		('Depth8Image [info]: remaining colors with error <= %1' bindWith:error) infoPrintCR.
+('Depth8Image [info]: remaining colors with error <= %1' bindWith:error) infoPrintCR.
-	    ].
+].
-	    error := error * 2.
+error := error * 2.
-	    error > 100 ifTrue:[
+error > 100 ifTrue:[
-		"
+"
-		 break out, if the error becomes too big.
+break out, if the error becomes too big.
-		"
+"
-		'Depth8Image [info]: hard color allocation problem - revert to b&w for remaining colors' infoPrintCR.
+'Depth8Image [info]: hard color allocation problem - revert to b&w for remaining colors' infoPrintCR.
-		"
+"
-		 map to b&w as a last fallback.
+map to b&w as a last fallback.
-		 (should really do a dither here)
+(should really do a dither here)
-		"
+"
-		usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
+usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
-		    |color
+|color
-		     mapIndex "{ Class: SmallInteger }"|
+mapIndex "{ Class: SmallInteger }"|
-		    mapIndex := aColorIndex + 1.
+mapIndex := aColorIndex + 1.
-		    "/ color := colorMap at:mapIndex.
+"/ color := colorMap at:mapIndex.
-		    color := self colorFromValue:aColorIndex.
+color := self colorFromValue:aColorIndex.
-		    color brightness > 0.4 ifTrue:[
+color brightness > 0.4 ifTrue:[
-			color := Color white.
+color := Color white.
-		    ] ifFalse:[
+] ifFalse:[
-			color := Color black.
+color := Color black.
-		    ].
+].
-		    imgMap at:mapIndex put:(color onDevice:aDevice).
+imgMap at:mapIndex put:(color onDevice:aDevice).
-		].
+].
-		fit := true.
+fit := true.
-	    ]
+]
-	].
+].
-	error > 10 ifTrue:[
+error > 10 ifTrue:[
-	    'Depth8Image [info]: not enough colors for a reasonable image' infoPrintCR
+'Depth8Image [info]: not enough colors for a reasonable image' infoPrintCR
-	] ifFalse:[
+] ifFalse:[
-	    'Depth8Image [info]: not enough colors for exact picture' infoPrintCR.
+'Depth8Image [info]: not enough colors for exact picture' infoPrintCR.
-	]
+]
 ].
 "
 create translation map (from image colors to allocated colorIds)
 "
 mapSize := imgMap size.
 map := ByteArray new:256.
 1 to:mapSize do:[:i |
-	(clr := imgMap at:i) notNil ifTrue:[
+(clr := imgMap at:i) notNil ifTrue:[
-	    map at:i put:clr colorId
+map at:i put:clr colorId
-	]
+]
 ].
 "
 does the device support 8-bit images ?
 "
 deviceDepth := aDevice depth.
 has8BitImage := (deviceDepth == 8)
-		    or:[ (aDevice supportedImageFormatForDepth:8) notNil ].
+or:[ (aDevice supportedImageFormatForDepth:8) notNil ].
 "
 finally, create a form on the device and copy (& translate)
 the pixel values
 "
 has8BitImage ifTrue:[
-	pseudoBits := ByteArray uninitializedNew:(width * height).
+pseudoBits := ByteArray uninitializedNew:(width * height).
-	bytes
+bytes
-	    expandPixels:8         "xlate only"
+expandPixels:8         "xlate only"
-	    width:width height:height
+width:width height:height
-	    into:pseudoBits
+into:pseudoBits
-	    mapping:map.
+mapping:map.
-	map := nil.
+map := nil.
-	f := Form width:width height:height depth:deviceDepth on:aDevice.
+f := Form width:width height:height depth:deviceDepth onDevice:aDevice.
-	f isNil ifTrue:[^ nil].
+f isNil ifTrue:[^ nil].
-	f colorMap:imgMap.
+f colorMap:imgMap.
-	f initGC.
+f initGC.
-	aDevice
+aDevice
-	    drawBits:pseudoBits
+drawBits:pseudoBits
-	    bitsPerPixel:8
+bitsPerPixel:8
-	    depth:deviceDepth
+depth:deviceDepth
-	    padding:8
+padding:8
-	    width:width height:height
+width:width height:height
-	    x:0 y:0
+x:0 y:0
-	    into:(f id) x:0 y:0
+into:(f id) x:0 y:0
-	    width:width height:height
+width:width height:height
-	    with:(f gcId).
+with:(f gcId).
-	^ f
+^ f
 ].
 "
 slow fall back: convert into appropriate depth image,
 by looping over each pixel individually
 newImage width:width.
 newImage height:height.
 newImage bits:(ByteArray uninitializedNew:(height * newImage bytesPerRow)).
 0 to:height-1 do:[:row |
-	pixelRow := self rowAt:row.
+pixelRow := self rowAt:row.
-	pixelRow
+pixelRow
-	    expandPixels:8         "xlate only"
+expandPixels:8         "xlate only"
-	    width:width
+width:width
-	    height:1
+height:1
-	    into:pixelRow
+into:pixelRow
-	    mapping:map.
+mapping:map.
-	newImage rowAt:row putAll:pixelRow
+newImage rowAt:row putAll:pixelRow
 ].
-f := Form width:width height:height depth:deviceDepth on:aDevice.
+f := Form width:width height:height depth:deviceDepth onDevice:aDevice.
 f isNil ifTrue:[^ nil].
 f colorMap:imgMap.
 f initGC.
 aDevice
-	drawBits:(newImage bits)
+drawBits:(newImage bits)
-	depth:deviceDepth
+depth:deviceDepth
-	padding:8
+padding:8
-	width:width height:height
+width:width height:height
-	x:0 y:0
+x:0 y:0
-	into:(f id) x:0 y:0
+into:(f id) x:0 y:0
-	width:width height:height
+width:width height:height
-	with:(f gcId).
+with:(f gcId).
 ^ f
 "Modified: 15.10.1997 / 01:48:20 / cg"
 "Created: 19.10.1997 / 04:57:05 / cg"
 ! !
 !Depth8Image class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.110 2007-05-29 17:19:59 cg Exp $'
+^ '$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.111 2007-05-31 15:29:12 stefan Exp $'
 ! !

changeset 4783	717a41ef31e4
parent 4764	80e412455815
child 4889	91227e415992