"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libview' }"

"{ NameSpace: Smalltalk }"

Image subclass:#Depth8Image

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Graphics-Images'

!

!Depth8Image class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    this class represents 256-color (8 bit / pixel) images (palette, greyscale ...).

    It mainly consists of methods already implemented in Image,

    reimplemented here for more performance.

    [author:]

	Claus Gittinger

    [see also:]

	Depth1Image Depth2Image Depth4Image Depth16Image Depth24Image

	ImageReader

"

! !

!Depth8Image class methodsFor:'queries'!

defaultPhotometric

    "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."

    ^ #palette

!

imageDepth

    "return the depth of images represented by instances of

     this class - here we return 8"

    ^ 8

    "Modified: 20.4.1996 / 23:40:22 / cg"

! !

!Depth8Image methodsFor:'accessing-pixels'!

pixelAtX:x y:y

    "retrieve a pixel at x/y; return a pixelValue.

     The interpretation of the returned value depends on the photometric

     and the colormap. See also Image>>atX:y:)

     Pixels start at x=0 , y=0 for upper left pixel, end at

     x = width-1, y=height-1 for lower right pixel"

    |index "{ Class: SmallInteger }"|

%{  /* NOCONTEXT */

    OBJ b = __INST(bytes);

    OBJ w = __INST(width);

    if (__isByteArrayLike(b)

     && __bothSmallInteger(x, y)

     && __isSmallInteger(w)

     && (__INST(pixelFunction)==nil) ) {

        int _idx, _pix;

        _idx = (__intVal(w) * __intVal(y)) + __intVal(x);

        if ((unsigned)_idx < __byteArraySize(b)) {

            _pix = __ByteArrayInstPtr(b)->ba_element[_idx];

            RETURN( __MKSMALLINT(_pix) );

        }

    }

%}.

    pixelFunction notNil ifTrue:[^ pixelFunction value:x value:y].

    "/ the code below is only evaluated if the bytes-collection is

    "/ not a ByteArray, or the arguments are not integers

    index := (width * y) + 1 + x.

    ^ bytes at:index.

!

pixelAtX:x y:y put:aPixelValue

    "set the pixel at x/y to aPixelValue.

     The interpretation of the pixelValue depends on the photometric

     and the colormap. (see also: Image>>atX:y:put:)

     Pixels start at x=0 , y=0 for upper left pixel, end at

     x = width-1, y=height-1 for lower right pixel"

    |index "{ Class: SmallInteger }"|

%{  /* NOCONTEXT */

    OBJ b = __INST(bytes);

    OBJ w = __INST(width);

    if (__isByteArrayLike(b)

     && __bothSmallInteger(x, y)

     && __bothSmallInteger(w, aPixelValue) ) {

        int _idx;

        _idx = (__intVal(w) * __intVal(y)) + __intVal(x);

        if ((unsigned)_idx < __byteArraySize(b)) {

            __ByteArrayInstPtr(b)->ba_element[_idx] = __intVal(aPixelValue);

            RETURN( self );

        }

    }

%}.

    "fall back code for nonByteArray or nonInteger arguments"

    index := (width * y) + 1 + x.

    bytes at:index put:aPixelValue.

!

rowAt:y into:aPixelBuffer startingAt:startIndex

    "fill aPixelBuffer with pixel values from a single row.

     Notice: row/column coordinates start at 0."

    |srcIdx endIndex n|

    bytes notNil ifTrue:[

        srcIdx := (y * width) + 1.

        n := width.

        endIndex := srcIdx+width-1.

        endIndex > bytes size ifTrue:[

            self assert:(bytes size >= endIndex).

            endIndex := bytes size.

            n := endIndex - srcIdx + 1.

        ].

        aPixelBuffer replaceFrom:startIndex to:startIndex+n-1 with:bytes startingAt:srcIdx.

        ^ self.

    ].

    ^ super rowAt:y into:aPixelBuffer startingAt:startIndex

    "Modified: / 16-02-2012 / 15:58:01 / cg"

!

rowAt:y putAll:pixelArray startingAt:startIndex

    "store a single row's bits from bits in the pixelArray argument;

     Notice: row/column coordinates start at 0."

    |dstIdx|

    dstIdx := (y * width) + 1.

    self bits replaceFrom:dstIdx to:dstIdx+width-1 with:pixelArray startingAt:startIndex.

    ^ pixelArray

    "Created: 24.4.1997 / 15:49:42 / cg"

! !

!Depth8Image methodsFor:'converting'!

fromImage:anImage

    "setup the receiver from another image.

     The code here is tuned for depth 1, 2 and 4 source images;

     other conversions are done in the superclasses fallBack method."

    |srcBytesPerRow "{ Class: SmallInteger }"

     srcIdx "{ Class: SmallInteger }"

     dstIdx "{ Class: SmallInteger }"

     w      "{ Class: SmallInteger }"

     h      "{ Class: SmallInteger }"

     srcBuffer dstBuffer srcBytes

     srcDepth map bytes|

    srcDepth := anImage depth.

    (#[1 2 4] includes:srcDepth) ifFalse:[

        ^ super fromImage:anImage

    ].

    width := w := anImage width.

    height := h := anImage height.

    bytes := ByteArray uninitializedNew:(w * h).

    bitsPerSample := self bitsPerSample.

    samplesPerPixel := self samplesPerPixel.

    self colormapFromImage:anImage.

    colorMap isNil ifTrue:[

        "/ if source has no colorMap, more work is needed ...

        map := #(

                #[0 16rFF]

                #[0 16r55 16rAA 16rFF]

                nil

                #[16r00 16r11 16r22 16r33 16r44 16r55 16r66 16r77

                  16r88 16r99 16rAA 16rBB 16rCC 16rDD 16rEE 16rFF]

               ) at:srcDepth.

    ].

    self mask:anImage mask.

    "/ only expand & translate pixels

    srcBytes := anImage bits.

    srcBytesPerRow := anImage bytesPerRow.

    srcBuffer := ByteArray new:srcBytesPerRow.

    dstBuffer := ByteArray new:w.

    srcIdx := 1.

    dstIdx := 1.

    bytes := self bits.

    bytes isNil ifTrue:[

        self bits:(bytes := ByteArray new:(self bytesPerRow * self height)).

    ].

    1 to:h do:[:hi |

        srcBuffer replaceFrom:1 to:srcBytesPerRow with:srcBytes startingAt:srcIdx.

        srcBuffer expandPixels:srcDepth width:w height:1 into:dstBuffer mapping:map.

        bytes replaceFrom:dstIdx to:dstIdx+w-1 with:dstBuffer startingAt:1.

        dstIdx := dstIdx + w.

        srcIdx := srcIdx + srcBytesPerRow.

    ]

    "

     |i1 i2 i4 i8 i16 i24|

     i1 := Image fromFile:'bitmaps/SBrowser.xbm'.

     i2 := Depth2Image fromImage:i1.

     i4 := Depth4Image fromImage:i1.

     i8 := Depth8Image fromImage:i1.

     i8 inspect.

     i8 := Depth8Image fromImage:i2.

     i8 inspect.

     i8 := Depth8Image fromImage:i4.

     i8 inspect.

    "

    "Modified: / 24-04-1997 / 14:01:14 / cg"

    "Modified: / 30-01-2017 / 19:33:25 / stefan"

! !

!Depth8Image methodsFor:'converting images'!

anyImageAsPseudoFormOn:aDevice

    "return a pseudoForm from the palette picture.

     The main work is in color reduction, when not all colors can be acquired.

     This method works for any photometric."

    |bytes pseudoBits f gcRound has8BitImage deviceDepth

     imgMap newImage pixelRow dColors

     usedColors usageCounts maxIndex map

     fit scale lastOK error

     div

     bitsPerRGB "{Class: SmallInteger }"

     shift      "{Class: SmallInteger }"

     m          "{Class: SmallInteger }"

     mapSize    "{Class: SmallInteger }"

     cube nR nG nB ditherColors clr|

    (cube := aDevice fixColors) notNil ifTrue:[

        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].

    ].

    "find used colors"

    bytes := self bits.

    usedColors := bytes usedValues.    "gets us an array filled with used values"

                                       "(could use bytes asBag)"

    maxIndex := usedColors max + 1.

    usedColors size > 20 ifTrue:[

        ('Depth8Image [info]: allocating ' , usedColors size printString , ' colors ...') infoPrintCR.

    ].

    "sort by usage"

    usageCounts := bytes usageCounts.

    usageCounts := (usedColors collect:[:clr | usageCounts at:(clr + 1)]) asArray.

    usageCounts sort:[:a :b | a > b] with:usedColors.

    "allocate the colors (in order of usage count)"

    imgMap := Array new:maxIndex.

    "

     first, try to get the exact colors ...

    "

    bitsPerRGB := aDevice bitsPerRGB.

    shift := (8 - bitsPerRGB) negated.

    m := (1 bitShift:bitsPerRGB) - 1.

    div := m asFloat.

    fit := true.

    scale := 100.0 / div.       "to scale 0..255 into 0.0 .. 100.0"

    lastOK := 0.

    gcRound := 0.

    usedColors do:[:aColorIndex |

        |devColor color

         mapIndex "{Class: SmallInteger }"|

        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

            ]

        ]

    ].

    fit ifFalse:[

        ('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] thenCollect:[:clr | clr exactOn:aDevice].

            dColors := dColors asSet.

            dColors addAll:(aDevice colorMap collect:[:c|c onDevice:aDevice] thenSelect:[: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 }"|

                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.

                    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

                    ]

                ].

            ].

            fit ifTrue:[

                ('Depth8Image [info]: remaining colors with error <= %1' bindWith:error) infoPrintCR.

            ].

            error := error * 2.

            error > 100 ifTrue:[