# HG changeset patch # User Stefan Vogel # Date 1180625352 -7200 # Node ID 717a41ef31e47c5765c80d841f9e54b2716419b5 # Parent ef80a2590a848baa237b976980d4e2b978b22391 Change senders of obsolete messages Form>>...on: to ...onDevice: diff -r ef80a2590a84 -r 717a41ef31e4 Depth8Image.st --- a/Depth8Image.st Thu May 31 17:29:03 2007 +0200 +++ b/Depth8Image.st Thu May 31 17:29:12 2007 +0200 @@ -251,36 +251,36 @@ cube nR nG nB ditherColors clr| (cube := aDevice fixColors) notNil ifTrue:[ - nR := aDevice numFixRed. - nG := aDevice numFixGreen. - nB := aDevice numFixBlue. + nR := aDevice numFixRed. + nG := aDevice numFixGreen. + nB := aDevice numFixBlue. - DitherAlgorithm == #floydSteinberg ifTrue:[ - f := self - asFloydSteinbergDitheredDepth8FormOn:aDevice - colors:cube - nRed:nR - nGreen:nG - nBlue:nB. - ] ifFalse:[ - f := self - asNearestPaintDepth8FormOn:aDevice - colors:cube - nRed:nR - nGreen:nG - nBlue:nB. - ]. - f notNil ifTrue:[^ f]. + DitherAlgorithm == #floydSteinberg ifTrue:[ + f := self + asFloydSteinbergDitheredDepth8FormOn:aDevice + colors:cube + nRed:nR + nGreen:nG + nBlue:nB. + ] ifFalse:[ + f := self + asNearestPaintDepth8FormOn:aDevice + colors:cube + nRed:nR + nGreen:nG + nBlue:nB. + ]. + 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" @@ -306,190 +306,190 @@ gcRound := 0. usedColors do:[:aColorIndex | - |devColor color - r "{Class: SmallInteger }" - g "{Class: SmallInteger }" - b "{Class: SmallInteger }" - mapIndex "{Class: SmallInteger }"| + |devColor color + r "{Class: SmallInteger }" + g "{Class: SmallInteger }" + b "{Class: SmallInteger }" + mapIndex "{Class: SmallInteger }"| - fit ifTrue:[ - mapIndex := aColorIndex + 1. - "/ color := colorMap at:mapIndex. + fit ifTrue:[ + mapIndex := aColorIndex + 1. + "/ color := colorMap at:mapIndex. - color := self colorFromValue:aColorIndex. - (color isOnDevice:aDevice) ifTrue:[ - "wow - an immediate hit" - devColor := color - ] ifFalse:[ - devColor := color exactOn:aDevice. - devColor isNil ifTrue:[ - " - could not allocate color - on the first round, do a GC to flush - unused colors - this may help if some colors where locked by - already free images. - " - gcRound == 0 ifTrue:[ - ObjectMemory scavenge; finalize. - devColor := color exactOn:aDevice. - gcRound := 1 - ]. - devColor isNil ifTrue:[ - gcRound == 1 ifTrue:[ - CollectGarbageWhenRunningOutOfColors ifTrue:[ - 'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR. - ObjectMemory incrementalGC; finalize. - devColor := color exactOn:aDevice. - ]. - gcRound := 2 - ] - ] - ]. - ]. - (devColor notNil and:[devColor colorId notNil]) ifTrue:[ - imgMap at:mapIndex put:devColor. - lastOK := lastOK + 1. - ] ifFalse:[ - fit := false - ] - ] + color := self colorFromValue:aColorIndex. + (color isOnDevice:aDevice) ifTrue:[ + "wow - an immediate hit" + devColor := color + ] ifFalse:[ + devColor := color exactOn:aDevice. + devColor isNil ifTrue:[ + " + could not allocate color - on the first round, do a GC to flush + unused colors - this may help if some colors where locked by + already free images. + " + gcRound == 0 ifTrue:[ + ObjectMemory scavenge; finalize. + devColor := color exactOn:aDevice. + gcRound := 1 + ]. + devColor isNil ifTrue:[ + gcRound == 1 ifTrue:[ + CollectGarbageWhenRunningOutOfColors ifTrue:[ + 'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR. + ObjectMemory incrementalGC; finalize. + devColor := color exactOn:aDevice. + ]. + gcRound := 2 + ] + ] + ]. + ]. + (devColor notNil and:[devColor colorId notNil]) ifTrue:[ + imgMap at:mapIndex put:devColor. + lastOK := lastOK + 1. + ] ifFalse:[ + 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:[ - dColors := imgMap collect:[:clr | clr isNil ifTrue:[clr] - ifFalse:[clr nearestOn:aDevice]]. - dColors := dColors select:[:clr | clr notNil]. - dColors := dColors collect:[:clr | clr exactOn:aDevice]. - dColors := dColors select:[:clr | clr notNil]. - dColors := dColors asSet. - dColors addAll:((aDevice colorMap collect:[:c|c onDevice:aDevice]) - select:[:c | c colorId notNil]). - ditherColors := aDevice availableDitherColors. - ditherColors notNil ifTrue:[ - dColors addAll:ditherColors. - ]. - dColors := dColors asArray. - dColors size > 256 ifTrue:[ - dColors := dColors copyTo:256 - ]. - ^ self asFloydSteinbergDitheredPseudoFormUsing:dColors on:aDevice - ]. + DitherAlgorithm == #floydSteinberg ifTrue:[ + dColors := imgMap collect:[:clr | clr isNil ifTrue:[clr] + ifFalse:[clr nearestOn:aDevice]]. + dColors := dColors select:[:clr | clr notNil]. + dColors := dColors collect:[:clr | clr exactOn:aDevice]. + dColors := dColors select:[:clr | clr notNil]. + dColors := dColors asSet. + dColors addAll:((aDevice colorMap collect:[:c|c onDevice:aDevice]) + select:[:c | c colorId notNil]). + ditherColors := aDevice availableDitherColors. + ditherColors notNil ifTrue:[ + dColors addAll:ditherColors. + ]. + dColors := dColors asArray. + dColors size > 256 ifTrue:[ + dColors := dColors copyTo:256 + ]. + ^ self asFloydSteinbergDitheredPseudoFormUsing:dColors on:aDevice + ]. - " - again, this time allow wrong colors (loop while increasing allowed error) - " - error := 1. - [fit] whileFalse:[ - fit := true. - usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex | - |devColor color - r "{Class: SmallInteger }" - g "{Class: SmallInteger }" - b "{Class: SmallInteger }" - mapIndex "{Class: SmallInteger }" - rMask "{Class: SmallInteger }" - gMask "{Class: SmallInteger }" - bMask "{Class: SmallInteger }"| + " + again, this time allow wrong colors (loop while increasing allowed error) + " + error := 1. + [fit] whileFalse:[ + fit := true. + usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex | + |devColor color + r "{Class: SmallInteger }" + g "{Class: SmallInteger }" + b "{Class: SmallInteger }" + mapIndex "{Class: SmallInteger }" + rMask "{Class: SmallInteger }" + gMask "{Class: SmallInteger }" + bMask "{Class: SmallInteger }"| - fit ifTrue:[ - gMask := bMask := rMask := m. + fit ifTrue:[ + gMask := bMask := rMask := m. - mapIndex := aColorIndex + 1. - "/ color := colorMap at:mapIndex. - color := self colorFromValue:aColorIndex. - r := (color red * 255 / 100.0) rounded. - g := (color green * 255 / 100.0) rounded. - b := (color blue * 255 / 100.0) rounded. + mapIndex := aColorIndex + 1. + "/ color := colorMap at:mapIndex. + color := self colorFromValue:aColorIndex. + r := (color red * 255 / 100.0) rounded. + g := (color green * 255 / 100.0) rounded. + b := (color blue * 255 / 100.0) rounded. - color := Color red:((r bitShift:shift) bitAnd:rMask) * scale - green:((g bitShift:shift) bitAnd:gMask) * scale - blue:((b bitShift:shift) bitAnd:bMask) * scale. + color := Color red:((r bitShift:shift) bitAnd:rMask) * scale + green:((g bitShift:shift) bitAnd:gMask) * scale + blue:((b bitShift:shift) bitAnd:bMask) * scale. - (color isOnDevice:aDevice) ifTrue:[ - "wow - an immediate hit" - devColor := color. - ] ifFalse:[ - devColor := color nearestOn:aDevice. - (devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[ - devColor := nil - ]. - devColor isNil ifTrue:[ - " - no free color - on the first round, do a GC to flush unused - colors - this may help if some colors where locked by already - free images. - " - gcRound == 0 ifTrue:[ - ObjectMemory scavenge; finalize. - devColor := color nearestOn:aDevice. - (devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[ - devColor := nil - ]. - gcRound := 1 - ]. - devColor isNil ifTrue:[ - gcRound == 1 ifTrue:[ - CollectGarbageWhenRunningOutOfColors ifTrue:[ - 'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR. - ObjectMemory incrementalGC; finalize. - devColor := color nearestOn:aDevice. - (devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[ - devColor := nil - ]. - ]. - gcRound := 2 - ] - ] - ]. - ]. - (devColor notNil and:[devColor colorId notNil]) ifTrue:[ - imgMap at:mapIndex put:devColor. - lastOK := lastOK + 1. - ] ifFalse:[ - fit := false - ] - ]. - ]. + (color isOnDevice:aDevice) ifTrue:[ + "wow - an immediate hit" + devColor := color. + ] ifFalse:[ + devColor := color nearestOn:aDevice. + (devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[ + devColor := nil + ]. + devColor isNil ifTrue:[ + " + no free color - on the first round, do a GC to flush unused + colors - this may help if some colors where locked by already + free images. + " + gcRound == 0 ifTrue:[ + ObjectMemory scavenge; finalize. + devColor := color nearestOn:aDevice. + (devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[ + devColor := nil + ]. + gcRound := 1 + ]. + devColor isNil ifTrue:[ + gcRound == 1 ifTrue:[ + CollectGarbageWhenRunningOutOfColors ifTrue:[ + 'Depth8Image [info]: force GC for possible color reclamation.' infoPrintCR. + ObjectMemory incrementalGC; finalize. + devColor := color nearestOn:aDevice. + (devColor notNil and:[(devColor deltaFrom:color) > error]) ifTrue:[ + devColor := nil + ]. + ]. + gcRound := 2 + ] + ] + ]. + ]. + (devColor notNil and:[devColor colorId notNil]) ifTrue:[ + imgMap at:mapIndex put:devColor. + lastOK := lastOK + 1. + ] ifFalse:[ + fit := false + ] + ]. + ]. - fit ifTrue:[ - ('Depth8Image [info]: remaining colors with error <= %1' bindWith:error) infoPrintCR. - ]. + fit ifTrue:[ + ('Depth8Image [info]: remaining colors with error <= %1' bindWith:error) infoPrintCR. + ]. - error := error * 2. - error > 100 ifTrue:[ - " - break out, if the error becomes too big. - " - 'Depth8Image [info]: hard color allocation problem - revert to b&w for remaining colors' infoPrintCR. - " - map to b&w as a last fallback. - (should really do a dither here) - " - usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex | - |color - mapIndex "{ Class: SmallInteger }"| + error := error * 2. + error > 100 ifTrue:[ + " + break out, if the error becomes too big. + " + 'Depth8Image [info]: hard color allocation problem - revert to b&w for remaining colors' infoPrintCR. + " + map to b&w as a last fallback. + (should really do a dither here) + " + usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex | + |color + mapIndex "{ Class: SmallInteger }"| - mapIndex := aColorIndex + 1. - "/ color := colorMap at:mapIndex. - color := self colorFromValue:aColorIndex. - color brightness > 0.4 ifTrue:[ - color := Color white. - ] ifFalse:[ - color := Color black. - ]. - imgMap at:mapIndex put:(color onDevice:aDevice). - ]. - fit := true. - ] - ]. + mapIndex := aColorIndex + 1. + "/ color := colorMap at:mapIndex. + color := self colorFromValue:aColorIndex. + color brightness > 0.4 ifTrue:[ + color := Color white. + ] ifFalse:[ + color := Color black. + ]. + imgMap at:mapIndex put:(color onDevice:aDevice). + ]. + fit := true. + ] + ]. - error > 10 ifTrue:[ - 'Depth8Image [info]: not enough colors for a reasonable image' infoPrintCR - ] ifFalse:[ - 'Depth8Image [info]: not enough colors for exact picture' infoPrintCR. - ] + error > 10 ifTrue:[ + 'Depth8Image [info]: not enough colors for a reasonable image' infoPrintCR + ] ifFalse:[ + 'Depth8Image [info]: not enough colors for exact picture' infoPrintCR. + ] ]. " @@ -498,9 +498,9 @@ mapSize := imgMap size. map := ByteArray new:256. 1 to:mapSize do:[:i | - (clr := imgMap at:i) notNil ifTrue:[ - map at:i put:clr colorId - ] + (clr := imgMap at:i) notNil ifTrue:[ + map at:i put:clr colorId + ] ]. " @@ -508,38 +508,38 @@ " 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 - expandPixels:8 "xlate only" - width:width height:height - into:pseudoBits - mapping:map. + bytes + expandPixels:8 "xlate only" + width:width height:height + into:pseudoBits + mapping:map. - map := nil. + map := nil. - f := Form width:width height:height depth:deviceDepth on:aDevice. - f isNil ifTrue:[^ nil]. - f colorMap:imgMap. - f initGC. - aDevice - drawBits:pseudoBits - bitsPerPixel:8 - depth:deviceDepth - padding:8 - width:width height:height - x:0 y:0 - into:(f id) x:0 y:0 - width:width height:height - with:(f gcId). - ^ f + f := Form width:width height:height depth:deviceDepth onDevice:aDevice. + f isNil ifTrue:[^ nil]. + f colorMap:imgMap. + f initGC. + aDevice + drawBits:pseudoBits + bitsPerPixel:8 + depth:deviceDepth + padding:8 + width:width height:height + x:0 y:0 + into:(f id) x:0 y:0 + width:width height:height + with:(f gcId). + ^ f ]. " @@ -552,30 +552,30 @@ newImage bits:(ByteArray uninitializedNew:(height * newImage bytesPerRow)). 0 to:height-1 do:[:row | - pixelRow := self rowAt:row. - pixelRow - expandPixels:8 "xlate only" - width:width - height:1 - into:pixelRow - mapping:map. - newImage rowAt:row putAll:pixelRow + pixelRow := self rowAt:row. + pixelRow + expandPixels:8 "xlate only" + width:width + height:1 + into:pixelRow + mapping:map. + 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) - depth:deviceDepth - padding:8 - width:width height:height - x:0 y:0 - into:(f id) x:0 y:0 - width:width height:height - with:(f gcId). + drawBits:(newImage bits) + depth:deviceDepth + padding:8 + width:width height:height + x:0 y:0 + into:(f id) x:0 y:0 + width:width height:height + with:(f gcId). ^ f @@ -2443,5 +2443,5 @@ !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 $' ! !