Depth24Image.st
author claus
Fri, 25 Feb 1994 14:13:21 +0100
changeset 35 f1a194c18429
parent 3 c0aaded4ef28
child 38 2652fc96e660
permissions -rw-r--r--
*** empty log message ***

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

Image subclass:#Depth24Image
         instanceVariableNames:''
         classVariableNames:''
         poolDictionaries:''
         category:'Graphics-Display Objects'
!

Depth24Image comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
              All Rights Reserved

this class represents truecolor (24 bit / pixel) images

$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.3 1994-02-25 13:10:20 claus Exp $

written summer 93 by claus
'!

!Depth24Image methodsFor:'accessing'!

bitsPerPixel
    "return the number of bits per pixel"

    ^ 24
!

bitsPerRow
    "return the number of bits in one scanline of the image"

    ^  width * 24
!

bitsPerSample
    "return the number of bits per sample.
     The return value is an array of bits-per-plane."

    ^ #(8 8 8)
!

bytesPerRow
    "return the number of bytes in one scanline of the image"

    ^ width * 3
!

samplesPerPixel
    "return the number of samples per pixel in the image."

    ^ 3
!

atX:x y:y
    "retrieve a pixel at x/y; return a color.
     Pixels start at x=0 , y=0 for upper left pixel, end at
     x = width-1, y=height-1 for lower right pixel"

    |index rVal gVal bVal|

    index := 1 + (((width * y) + x) * 3).
    rVal := bytes at:(index).
    gVal := bytes at:(index + 1).
    bVal := bytes at:(index + 2).

    photometric ~~ #rgb ifTrue:[
        self error:'format not supported'.
        ^ nil
    ].
    ^ Color red:rVal * 100 / 255
          green:gVal * 100 / 255
           blue:bVal * 100 / 255
!

valueAtX:x y:y
    "retrieve a pixel at x/y; return a color.
     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 }"
     rVal  "{ Class: SmallInteger }"
     gVal  "{ Class: SmallInteger }"
     bVal  "{ Class: SmallInteger }"|

    index := 1 + (((width * y) + x) * 3).
    rVal := bytes at:(index).
    gVal := bytes at:(index + 1).
    bVal := bytes at:(index + 2).
    ^ (((rVal bitShift:8) bitOr:gVal) bitShift:8) bitOr:bVal
!

atX:x y:y putValue:aPixelValue
    "set a pixel at x/y to aPixelValue, which is 24 bits RGB.
     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 }"
     val   "{ Class: SmallInteger }" |

    index := 1 + (((width * y) + x) * 3).
    val := aPixelValue.
    bytes at:(index + 2) put:(val bitAnd:16rFF).
    val := val bitShift:-8.
    bytes at:(index + 1) put:(val bitAnd:16rFF).
    val := val bitShift:-8.
    bytes at:(index) put:val.
!

atY:y from:xLow to:xHigh do:aBlock
    "perform aBlock for each pixel from x1 to x2 in row y.
     The block is passed the color at each pixel.
     This method allows slighly faster processing of an
     image than using atX:y:, since some processing can be
     avoided when going from pixel to pixel. However, for
     real image processing, specialized methods should be written."

    |srcIndex "{ Class: SmallInteger }"
     x1       "{ Class: SmallInteger }"
     x2       "{ Class: SmallInteger }"
     rVal     "{ Class: SmallInteger }"
     gVal     "{ Class: SmallInteger }"
     bVal     "{ Class: SmallInteger }"
     lastR lastG lastB lastColor|

    photometric ~~ #rgb ifTrue:[
        self error:'format not supported'.
        ^ nil
    ].

    x1 := xLow.
    x2 := xHigh.

    srcIndex := 1 + (((width * y) + x1) * 3).

    x1 to:x2 do:[:x |
        rVal := bytes at:(srcIndex).
        gVal := bytes at:(srcIndex + 1).
        bVal := bytes at:(srcIndex + 2).
        srcIndex := srcIndex + 3.
        (rVal == lastR and:[gVal == lastG and:[bVal == lastB]]) ifFalse:[
            lastColor := Color red:rVal * 100 / 255
                             green:gVal * 100 / 255
                              blue:bVal * 100 / 255.
            lastR := rVal.
            lastG := gVal.
            lastB := bVal.
        ].
        aBlock value:x value:lastColor
    ]
! !

!Depth24Image methodsFor:'converting rgb images'!

rgbImageAsGreyFormOn:aDevice
    "convert an rgb image to a grey image for greyscale displays"

    |deviceDepth|

    deviceDepth := aDevice depth.

    "I have specially tuned methods for monochrome"
    (deviceDepth == 1) ifTrue:[
        DitherAlgorithm == #error ifTrue:[
            ^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
        ].
        DitherAlgorithm == #pattern ifTrue:[
            ^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
        ].
        ^ self rgbImageAsMonoFormOn:aDevice
    ].

    "and for 2plane greyscale (i.e. NeXTs)"
    (deviceDepth == 2) ifTrue:[
        DitherAlgorithm == #error  ifTrue:[
            ^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
        ].
        DitherAlgorithm == #pattern  ifTrue:[
            ^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
        ].
        ^ self rgbImageAs2PlaneFormOn:aDevice
    ].

    (deviceDepth == 8) ifTrue:[
        ^ self rgbImageAs8BitGreyFormOn:aDevice
    ].

    "mhmh need another converter ...
     till then we do:"
    DitherAlgorithm == #error  ifTrue:[
        ^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
    ].
    DitherAlgorithm == #pattern  ifTrue:[
        ^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
    ].
    ^ self rgbImageAsMonoFormOn:aDevice
!

rgbImageAsMonoFormOn:aDevice
    "return a 1-bit monochrome form for aDevice from the rgb picture,
     using a threshold algorithm. 
     (i.e. grey value < 0.5 -> black, grey value >= 0.5 -> white)."

    |monoBits f
     w        "{ Class: SmallInteger }"
     h        "{ Class: SmallInteger }"
     r        "{ Class: SmallInteger }"
     g        "{ Class: SmallInteger }"
     b        "{ Class: SmallInteger }"
     v        "{ Class: SmallInteger }"
     map rMap gMap bMap
     srcIndex "{ Class: SmallInteger }"
     dstIndex "{ Class: SmallInteger }"
     bits     "{ Class: SmallInteger }"
     bitCount "{ Class: SmallInteger }"
     fast |

    w := width.
    h := height.
    monoBits := ByteArray uninitializedNew:(((w + 7) // 8) * h).
    fast := false.
%{
    register unsigned char *srcPtr, *dstPtr;
    register _v, _bits, _bitCount;
    register j;
    register i;
    extern OBJ ByteArray;

    if (__isByteArray(_INST(bytes)) && __isByteArray(monoBits)) {
        fast = true;
        srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
        dstPtr = _ByteArrayInstPtr(monoBits)->ba_element;
        for (i=_intVal(h); i>0; i--) {
            _bitCount = 0;
            _bits = 0;
            for (j=_intVal(w); j>0; j--) {
                _bits <<= 1; 

                _v = (*srcPtr++ * 3);   /* 0.3*r + 0.6*g + b */
                _v += (*srcPtr++ * 6);
                _v += *srcPtr++;
                _v /= 10;
                if (_v & 0x80)
                    _bits |= 1;

                _bitCount++;
                if (_bitCount == 8) {
                    *dstPtr++ = _bits;
                    _bits = 0;
                    _bitCount = 0;
                }
            }
            if (_bitCount != 0) {
                while (_bitCount++ != 8) _bits <<= 1;
                *dstPtr++ = _bits;
            }
        }
    }
%}
.
    fast ifFalse:[
        srcIndex := 1.
        dstIndex := 1.
        1 to:h do:[:row |
            bitCount := 0.
            bits := 0.
            1 to:w do:[:col |
                bits := bits bitShift:1.

                r := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                g := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                b := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                v := ((3 * r) + (6 * g) + (1 * b)) // 10.
                ((v bitAnd:16r80) == 0) ifFalse:[
                    bits := bits bitOr:1
                ].
                bitCount := bitCount + 1.
                (bitCount == 8) ifTrue:[
                    monoBits at:dstIndex put:bits.
                    dstIndex := dstIndex + 1.
                    bits := 0.
                    bitCount := 0
                ]
            ].
            (bitCount ~~ 0) ifTrue:[
                [bitCount == 8] whileFalse:[
                    bitCount := bitCount + 1.
                    bits := bits bitShift:1.
                ].
                monoBits at:dstIndex put:bits.
                dstIndex := dstIndex + 1
            ]
        ]
    ].

    f := Form width:w height:h depth:1 on:aDevice.
    f isNil ifTrue:[^ nil].
    f initGC.
    (aDevice blackpixel == 0) ifFalse:[
        "have to invert bits"
        f function:#copyInverted
    ].
    aDevice drawBits:monoBits depth:1 width:w height:h
                   x:0 y:0
                into:(f id) x:0 y:0 width:w height:h with:(f gcId).
    ^ f
!

rgbImageAs2PlaneFormOn:aDevice
    "return a 2-bit device form for aDevice from the rgb picture,
     using a threshold algorithm. 
     (i.e. grey value < 0.25 -> black // 0.25..0.5 -> darkgrey //
      0.5 .. 0.75 -> lightgrey // > 0.75 -> white)."

    |twoPlaneBits f
     map rMap gMap bMap 
     fast
     r        "{ Class: SmallInteger }"
     g        "{ Class: SmallInteger }"
     b        "{ Class: SmallInteger }"
     v        "{ Class: SmallInteger }"
     w        "{ Class: SmallInteger }"
     h        "{ Class: SmallInteger }"
     srcIndex "{ Class: SmallInteger }"
     dstIndex "{ Class: SmallInteger }"
     bits     "{ Class: SmallInteger }"
     bitCount "{ Class: SmallInteger }" |

    w := width.
    h := height.
    twoPlaneBits := ByteArray uninitializedNew:(((w * 2 + 7) // 8) * h).

    fast := false.
%{
    register unsigned char *srcPtr, *dstPtr;
    register _v, _bits, _bitCount;
    register j;
    register i;
    extern OBJ ByteArray;

    if ((_Class(_INST(bytes)) == ByteArray)
     && (_Class(twoPlaneBits) == ByteArray)) {
        fast = true;
        srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
        dstPtr = _ByteArrayInstPtr(twoPlaneBits)->ba_element;
        for (i=_intVal(h); i>0; i--) {
            _bitCount = 0;
            _bits = 0;
            for (j=_intVal(w); j>0; j--) {
                _v = (*srcPtr++ * 3);   /* 0.3*r + 0.6*g + b */
                _v += (*srcPtr++ * 6);
                _v += *srcPtr++;
                _v /= 10;
                _bits <<= 2; 
                _bits |= (_v >> 6); /* take top 2 bits */
                _bitCount++;
                if (_bitCount == 4) {
                    *dstPtr++ = _bits;
                    _bits = 0;
                    _bitCount = 0;
                }
            }
            if (_bitCount != 0) {
                while (_bitCount++ != 4) _bits <<= 2;
                *dstPtr++ = _bits;
            }
        }
    }
%}
.
    fast ifFalse:[
        srcIndex := 1.
        dstIndex := 1.
        1 to:h do:[:row |
            bitCount := 0.
            bits := 0.
            1 to:w do:[:col |
                r := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                g := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                b := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                v := ((3 * r) + (6 * g) + (1 * b)) // 10.
                v := v bitShift:-6. "take 2 hi bits"
                bits := (bits bitShift:2) bitOr:v.
                bitCount := bitCount + 1.
                (bitCount == 4) ifTrue:[
                    twoPlaneBits at:dstIndex put:bits.
                    dstIndex := dstIndex + 1.
                    bits := 0.
                    bitCount := 0
                ]
            ].
            (bitCount ~~ 0) ifTrue:[
                [bitCount == 4] whileFalse:[
                    bitCount := bitCount + 1.
                    bits := bits bitShift:2.
                ].
                twoPlaneBits at:dstIndex put:bits.
                dstIndex := dstIndex + 1
            ]
        ]
    ].

    f := Form width:width height:height depth:2 on:aDevice.
    f isNil ifTrue:[^ nil].
    f initGC.
    (aDevice blackpixel == 0) ifFalse:[
        "have to invert bits"
        f function:#copyInverted
    ].
    aDevice drawBits:twoPlaneBits depth:2 width:width height:height
                   x:0 y:0
                into:(f id) x:0 y:0 width:width height:height with:(f gcId).
    ^ f
!

rgbImageAs8BitGreyFormOn:aDevice
    "return an 8-bit greyForm from the rgb picture"

    |greyBits f v
     srcIndex "{ Class: SmallInteger }"
     dstIndex "{ Class: SmallInteger }"
     fast|

    greyBits := ByteArray uninitializedNew:(width * height).
    fast := false.
%{
    register unsigned char *srcPtr, *dstPtr;
    register _v;
    register j;
    register i;
    extern OBJ ByteArray;

    if ((_Class(_INST(bytes)) == ByteArray)
     && (_Class(greyBits) == ByteArray)) {
        fast = true;
        srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
        dstPtr = _ByteArrayInstPtr(greyBits)->ba_element;
        for (i=_intVal(_INST(height)); i>0; i--) {
            for (j=_intVal(_INST(width)); j>0; j--) {
                _v = (*srcPtr * 3);     /* 0.3*r + 0.6*g + b */
                _v += (*srcPtr++ * 6);
                _v += *srcPtr++;
                _v /= 10;
                *dstPtr++ = _v >> 4 ;
            }
        }
    }
%}
.
    fast ifFalse:[
        srcIndex := 1.
        dstIndex := 1.

        1 to:height do:[:h |
            1 to:width do:[:w |
                |v
                 r        "{ Class: SmallInteger }"
                 g        "{ Class: SmallInteger }"
                 b        "{ Class: SmallInteger }"|

                r := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                g := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                b := bytes at:srcIndex.
                srcIndex := srcIndex + 1.

                v := ((3 * r) + (6 * g) + (1 * b)) // 10.
                v := v bitShift:-4.
                greyBits at:dstIndex put:v.
                dstIndex := dstIndex + 1
            ]
        ]
    ].

    f := Form width:width height:height depth:8 on:aDevice.
    f isNil ifTrue:[^ nil].
    f initGC.
    aDevice drawBits:greyBits depth:8 width:width height:height
                       x:0 y:0
                    into:(f id) x:0 y:0 
                   width:width height:height with:(f gcId).
    ^ f
!

rgbImageAsPatternDitheredGreyFormOn:aDevice
    "return a dithered greyForm for aDevice from the palette picture.
     works for any destination depth.
     A slow algorithm, using draw into the form (which indirectly does
     the dither) - should be rewritten."

    |f depth
     nDither       "{Class: SmallInteger }"
     nColors       "{Class: SmallInteger }"
     v             "{Class: SmallInteger }"
     h             "{Class: SmallInteger }"
     w             "{Class: SmallInteger }"
     srcIndex      "{Class: SmallInteger }"
     dstIndex      "{Class: SmallInteger }"
     mask          "{Class: SmallInteger }"
     outBits       "{Class: SmallInteger }"
     outCount      "{Class: SmallInteger }"
     patternOffset "{Class: SmallInteger }"
     patternBits   "{Class: SmallInteger }"
     run           "{Class: SmallInteger }"
     r             "{Class: SmallInteger }"
     g             "{Class: SmallInteger }"
     b             "{Class: SmallInteger }"
     index         "{Class: SmallInteger }"
     p0            "{Class: SmallInteger }"
     p1            "{Class: SmallInteger }" 
     map last clr
     patterns formBytes patternBytes 
     pixel0bytes pixel1bytes ditherPattern
     ditherColors first delta|

    Transcript showCr:'dithering ..'. Transcript endEntry.

    h := height.
    w := width.

    nDither := NumberOfDitherColors.
    ditherColors := Array new:nDither.

    first := (100 / nDither / 2).
    delta := 100 / nDither.
    0 to:nDither-1 do:[:i |
        ditherColors at:i+1 put:(Color grey:(i * delta + first)).
    ].

    nColors := 256.
    map := Array new:256.
    1 to:256 do:[:i |
        v := i - 1.
        " v is now in the range 0 .. 255 "
        v := (v * (nDither - 1) // 255) rounded.
        " v is now 0 .. nDither-1 "
        map at:i put:(ditherColors at:(v + 1))
    ].

    "tuning - code below is so slooow"

    "get the patterns, fill form bytes here"

    w := width.
    h := height.

    depth := aDevice depth.
    depth == 1 ifTrue:[
        formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
        patterns := Array new:nColors.
        pixel0bytes := ByteArray uninitializedNew:nColors.
        pixel1bytes := ByteArray uninitializedNew:nColors.

        "extract dither patterns and values to use for 1/0 bits
         in those from the dithercolors"

        1 to:nColors do:[:i |
            clr := (map at:i) on:aDevice.
            ditherPattern := clr ditherForm.

            ditherPattern isNil ifTrue:[
                patterns at:i put:#[2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111].
                pixel0bytes at:i put:clr colorId.
                pixel1bytes at:i put:clr colorId
            ] ifFalse:[
                patterns at:i put:(ditherPattern bits).
                pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
                pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
            ].
        ].

        srcIndex := 1.
        dstIndex := 1.
        mask := 16r80.
        outBits := 0.
        patternOffset := 1.
        1 to:h do:[:dstY |
            last := nil.
            1 to:w do:[:dstX |
                r := bytes at:srcIndex.
                g := bytes at:(srcIndex + 1).
                b := bytes at:(srcIndex + 2).
                srcIndex := srcIndex + 3.

                v := ((3 * r) + (6 * g) + (1 * b)).                "pixel grey value (*10)"
                v == last ifFalse:[
                    index := v // 10 + 1.                          "index into map"

                    patternBytes := patterns at:index.             "dither pattern for color"
                    patternBits := patternBytes at:patternOffset.  "dither row"
                    p0 := pixel0bytes at:index.                         "value for 0-dither bit"
                    p1 := pixel1bytes at:index.                         "value for 1-dither bit"
                    last := v.
                ].
                outBits := outBits bitShift:1.

                (patternBits bitAnd:mask) == 0 ifTrue:[
                    outBits := outBits bitOr:p0.
                ] ifFalse:[
                    outBits := outBits bitOr:p1
                ].
                mask := mask bitShift:-1.
                mask == 0 ifTrue:[
                    mask := 16r80.
                    formBytes at:dstIndex put:outBits.
                    dstIndex := dstIndex + 1.
                    outBits := 0
                ]
            ].
            mask == 16r80 ifFalse:[
                [mask == 0] whileFalse:[
                    mask := mask bitShift:-1.
                    outBits := outBits bitShift:1.
                ].
                formBytes at:dstIndex put:outBits.
                dstIndex := dstIndex + 1.
                mask := 16r80.
                outBits := 0
            ].
            patternOffset := patternOffset + 1.
            patternOffset == 9 ifTrue:[
                patternOffset := 1
            ]
        ].
        f := Form width:w height:h fromArray:formBytes.
        ^ f
    ].

    depth == 2 ifTrue:[
        formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
        patterns := Array new:nColors.
        pixel0bytes := ByteArray uninitializedNew:nColors.
        pixel1bytes := ByteArray uninitializedNew:nColors.

        "extract dither patterns and values to use for 1/0 bits
         in those from the dithercolors"

        1 to:nColors do:[:i |
            clr := (map at:i) on:aDevice.
            ditherPattern := clr ditherForm.

            ditherPattern isNil ifTrue:[
                patterns at:i put:#[2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111
                                    2r11111111].
                pixel0bytes at:i put:clr colorId.
                pixel1bytes at:i put:clr colorId
            ] ifFalse:[
                patterns at:i put:(ditherPattern bits).
                pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
                pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
            ].
        ].

        srcIndex := 1.
        dstIndex := 1.
        mask := 16r80.
        outBits := 0.
        patternOffset := 1.
        1 to:h do:[:dstY |
            last := nil.
            outCount := 0.
            mask := 16r80.
            outBits := 0.
            1 to:w do:[:dstX |
                r := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                g := bytes at:srcIndex.
                srcIndex := srcIndex + 1.
                b := bytes at:srcIndex.
                srcIndex := srcIndex + 1.

                v := ((3 * r) + (6 * g) + (1 * b)).                "pixel grey value (*10)"
                v == last ifFalse:[
                    index := v // 10 + 1.                          "index into map"

                    patternBytes := patterns at:index.             "dither pattern for color"
                    patternBits := patternBytes at:patternOffset.  "dither row"
                    p0 := pixel0bytes at:index.                    "value for 0-dither bit"
                    p1 := pixel1bytes at:index.                    "value for 1-dither bit"
                    last := v.
                ].
                outBits := outBits bitShift:2.

                (patternBits bitAnd:mask) == 0 ifTrue:[
                    outBits := outBits bitOr:p0.
                ] ifFalse:[
                    outBits := outBits bitOr:p1
                ].
                mask := mask bitShift:-1.
                outCount := outCount + 1.
                outCount == 4 ifTrue:[
                    formBytes at:dstIndex put:outBits.
                    dstIndex := dstIndex + 1.
                    outBits := 0.
                    outCount := 0.
                    mask == 0 ifTrue:[
                        mask := 16r80.
                    ]
                ]
            ].
            (outCount == 0) ifFalse:[
                [outCount == 4] whileFalse:[
                    outCount := outCount + 1.
                    outBits := outBits bitShift:2.
                ].
                formBytes at:dstIndex put:outBits.
                dstIndex := dstIndex + 1.
            ].
            patternOffset := patternOffset + 1.
            patternOffset == 9 ifTrue:[
                patternOffset := 1
            ]
        ].
        f := Form width:w height:h depth:depth.
        f initGC.
        f device drawBits:formBytes depth:2
                    width:w height:h x:0 y:0
                     into:f id x:0 y:0 width:w height:h with:f gcId.
        ^ f
    ].

    "draw each pixel using dither color (let others do the dithering)
     although the code is simple, its very slow"

    f := Form width:w height:h depth:(aDevice depth) on:aDevice.
    f isNil ifTrue:[^ nil].
    f initGC.
    "draw each pixel using dither color"

    srcIndex := 1.
    0 to:h-1 do:[:dstY |
        run := 0.
        last := nil.
        0 to:w-1 do:[:dstX |
            r := bytes at:srcIndex.
            srcIndex := srcIndex + 1.
            g := bytes at:srcIndex.
            srcIndex := srcIndex + 1.
            b := bytes at:srcIndex.
            srcIndex := srcIndex + 1.

            v := ((3 * r) + (6 * g) + (1 * b)) // 10.

            clr := map at:(v + 1).

            clr == last ifTrue:[
                run := run + 1
            ] ifFalse:[
                (run ~~ 0) ifTrue:[
                    f fillRectangleX:dstX-run y:dstY width:run height:1.
                ].
                run := 1.
                f paint:clr.
                last := clr
            ].
        ].
        f fillRectangleX:width-run y:dstY width:run height:1.
    ].
    ^ f

!

rgbImageAsPseudoFormOn:aDevice
    "return a pseudocolor form from the rgb-picture"

    |pseudoBits f
     r        "{ Class: SmallInteger }"
     g        "{ Class: SmallInteger }"
     b        "{ Class: SmallInteger }"
     srcIndex "{ Class: SmallInteger }"
     dstIndex "{ Class: SmallInteger }"
     rMask    "{ Class: SmallInteger }"
     gMask    "{ Class: SmallInteger }"
     bMask    "{ Class: SmallInteger }"
     redArray greenArray blueArray
     dataSize "{ Class: SmallInteger }"
     nColors  "{ Class: SmallInteger }"
     fit fitMap colors color 
     fast
     colorIndex "{ Class: SmallInteger }"
     depth nColorCells|

    "find used colors; build color-tree"

    fit := false.                       
    fitMap := false.
    depth := aDevice depth.
    nColorCells := aDevice ncells.

    rMask := 2r11111111.
    gMask := 2r11111111.
    bMask := 2r11111111.

    [fit] whileFalse:[
        [fitMap] whileFalse:[
            srcIndex := 1.
            redArray := Array new:256.

            "find used colors"

            nColors := 0.
            srcIndex := 1.
            dataSize := bytes size.
            [srcIndex < dataSize] whileTrue:[
%{
                if (__isByteArray(_INST(bytes))) {
                    int sI = _intVal(srcIndex);
                    unsigned char *cp = (unsigned char *)
                                    (_ArrayInstPtr(_INST(bytes))->a_element);

                    r = _MKSMALLINT((cp[sI - 1] & _intVal(rMask)) + 1);
                    g = _MKSMALLINT((cp[sI]     & _intVal(gMask)) + 1);
                    b = _MKSMALLINT((cp[sI + 1] & _intVal(bMask)) + 1);
                    srcIndex = _MKSMALLINT(sI + 3);
                    fast = true;
                } else {
                    fast = false;
                }
%}
.
                fast ifFalse:[
                    r := bytes at:srcIndex.
                    r := (r bitAnd:rMask) + 1.
                    srcIndex := srcIndex + 1.
                    g := bytes at:srcIndex.
                    g := (g bitAnd:gMask) + 1.
                    srcIndex := srcIndex + 1.
                    b := bytes at:srcIndex.
                    b := (b bitAnd:bMask) + 1.
                    srcIndex := srcIndex + 1
                ].

                greenArray := redArray at:r.
                greenArray isNil ifTrue:[
                    greenArray := Array new:256.
                    redArray at:r put:greenArray
                ].
                blueArray := greenArray at:g.
                blueArray isNil ifTrue:[
                    blueArray := Array new:256.
                    greenArray at:g put:blueArray
                ].
                (blueArray at:b) isNil ifTrue:[
                    blueArray at:b put:true.
                    nColors := nColors + 1.
                    (nColors > nColorCells) ifTrue:[
                        'more than ' print. nColorCells print. 
                        ' colors' printNewline.
                        srcIndex := dataSize + 1
                    ]
                ]
            ].

            "again with less color bits if it does not fit colormap"

            (nColors <= nColorCells) ifTrue:[
                fitMap := true
            ] ifFalse:[
                "must try again - cutting off some bits"
                (bMask == 2r11111111) ifTrue:[
                    bMask := 2r11111110
                ] ifFalse:[
                    rMask := (rMask bitShift:1) bitAnd:2r11111111.
                    gMask := (gMask bitShift:1) bitAnd:2r11111111.
                    bMask := (bMask bitShift:1) bitAnd:2r11111111
                ].
    'masks:' print. rMask print. ' ' print. gMask print. ' ' print.
    bMask printNewline
            ]
        ].

        nColors print. ' colors used' printNewline.
        colors := Array new:nColors.
        colorIndex := 1.

        "allocate all used colors"

        fit := true.

        r := 0.
        redArray do:[:greenArray |
            (fit and:[greenArray notNil]) ifTrue:[
                g := 0.
                greenArray do:[:blueArray |
                    (fit and:[blueArray notNil]) ifTrue:[
                        b := 0.
                        blueArray do:[:x |
                            (fit and:[x notNil]) ifTrue:[
                                color := Color red:(r * 100.0 / 255.0)
                                             green:(g * 100.0 / 255.0)
                                              blue:(b * 100.0 / 255.0).
                                color := color on:aDevice.
                                color colorId isNil ifTrue:[
                                    fit := false
                                ] ifFalse:[
                                    colors at:colorIndex put:color.
                                    colorIndex := colorIndex + 1.
                                    blueArray at:(b + 1) 
                                             put:color colorId
                                ]
                            ].
                            b := b + 1
                        ]
                    ].
                    g := g + 1
                ]
            ].
            r := r + 1
        ].

        "again with less color bits if we didnt get all colors"

        fit ifFalse:[
           'still no fit' printNewline.

            "free the allocated colors"
            colors atAllPut:nil.
            "a kludge - force immediate freeing of colors"
            ObjectMemory scavenge.

            "cut off one more color-bit - cut off blue first"
            (bMask == 2r11111111) ifTrue:[
                bMask := 2r11111110
            ] ifFalse:[
                (bMask == 2r11111110) ifTrue:[
                    bMask := 2r11111100
                ] ifFalse:[
                    rMask := (rMask bitShift:1) bitAnd:2r11111111.
                    gMask := (gMask bitShift:1) bitAnd:2r11111111.
                    bMask := (bMask bitShift:1) bitAnd:2r11111111
                ]
            ].
            fitMap := false.
            redArray := nil
        ]
    ].

    "create pseudocolor bits and translate"

    pseudoBits := ByteArray uninitializedNew:(width * height).

    srcIndex := 1.
    dstIndex := 1.

    [srcIndex < dataSize] whileTrue:[
        r := bytes at:srcIndex.
        r := r bitAnd:rMask.
        srcIndex := srcIndex + 1.
        g := bytes at:srcIndex.
        g := g bitAnd:gMask.
        srcIndex := srcIndex + 1.
        b := bytes at:srcIndex.
        b := b bitAnd:bMask.
        srcIndex := srcIndex + 1.
        greenArray := redArray at:(r + 1).
        blueArray := greenArray at:(g + 1).
        pseudoBits at:dstIndex put:(blueArray at:(b + 1)).
        dstIndex := dstIndex + 1
    ].

    f := Form width:width height:height depth:8 on:aDevice.
    f isNil ifTrue:[^ nil].
    f colorMap:colors.
    f initGC.
    aDevice drawBits:pseudoBits depth:8 width:width height:height
                    x:0 y:0
                 into:(f id) x:0 y:0 width:width height:height with:(f gcId).
    ^ f
! !

!Depth24Image methodsFor:'magnification'!

magnifyRowFrom:srcBytes offset:srcStart
          into:dstBytes offset:dstStart factor:mX

    "magnify a single pixel row - can only magnify by integer factors"

%{
    unsigned char *srcP, *dstP;
    int _mag;
    REGISTER int i;
    REGISTER unsigned char byte1, byte2, byte3;
    int _pixels;

    if (_isSmallInteger(srcStart) && _isSmallInteger(dstStart)
     && _isSmallInteger(_INST(width)) && _isSmallInteger(mX)
     && __isByteArray(srcBytes) && __isByteArray(dstBytes)) {
        _mag = _intVal(mX);
        srcP = _ByteArrayInstPtr(srcBytes)->ba_element - 1 + _intVal(srcStart);
        dstP = _ByteArrayInstPtr(dstBytes)->ba_element - 1 + _intVal(dstStart);
        _pixels = _intVal(_INST(width));

        while (_pixels--) {
            byte1 = *srcP;
            byte2 = *(srcP+1);
            byte3 = *(srcP+2);
            srcP += 3;
            for (i=_mag; i>0; i--) {
                *dstP = byte1;
                *(dstP+1) = byte2;
                *(dstP+2) = byte3;
                dstP += 3;
            }
        }
        RETURN (self);
    }
%}
.
    self primitiveFailed
!

hardMagnifyBy:extent
    "return a new image magnified by extent, aPoint.
     This is  the general magnification method, handling non-integral values"

    |mX mY
     newWidth  "{ Class: SmallInteger }"
     newHeight "{ Class: SmallInteger }"
     w         "{ Class: SmallInteger }"
     h         "{ Class: SmallInteger }"
     newImage newBytes
     value     "{ Class: SmallInteger }"
     srcRowIdx "{ Class: SmallInteger }"
     srcIndex  "{ Class: SmallInteger }"
     dstIndex  "{ Class: SmallInteger }"|

    mX := extent x.
    mY := extent y.
    ((mX < 0) or:[mY < 0]) ifTrue:[^ nil].
    ((mX = 1) and:[mY = 1]) ifTrue:[^ self].

    newWidth := (width * mX) truncated.
    newHeight := (height * mY) truncated.
    newBytes := ByteArray uninitializedNew:(newWidth * 3 * newHeight).

    newImage := self species new.
    newImage bits:newBytes.
    newImage width:newWidth.
    newImage height:newHeight.
    newImage photometric:photometric.
    newImage samplesPerPixel:samplesPerPixel.
    newImage bitsPerSample:#(8 8 8).

    "walk over destination image fetching pixels from source image"

    mY := mY asFloat.
    mX := mX asFloat.
%{
    REGISTER unsigned char *_dstP = _ByteArrayInstPtr(newBytes)->ba_element;
    unsigned char *_srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
    unsigned char *_srcRowP, *sP;
    int _width3 = _intVal(_INST(width)) * 3;
    int _w = _intVal(newWidth) - 1;
    int _h = _intVal(newHeight) - 1;
    int _row, _col;
    double _mX = _floatVal(mX);
    double _mY = _floatVal(mY);

    for (_row = 0; _row <= _h; _row++) {
        _srcRowP = _srcP + (_width3 * (int)((double)_row / _mY));
        for (_col = 0; _col <= _w; _col++) {
            sP = _srcRowP + (((int)((double)_col / _mX)) * 3);
            _dstP[0] = sP[0];
            _dstP[1] = sP[1];
            _dstP[2] = sP[2];
	    _dstP += 3;
        }
    }
%}
.
"
    dstIndex := 1.
    w := newWidth - 1.
    h := newHeight - 1.
    0 to:h do:[:row |
        srcRowIdx := (width * 3 * (row // mY)) + 1.
        0 to:w do:[:col |
            srcIndex := srcRowIdx + ((col // mX) * 3).
            value := bytes at:srcIndex.
            newBytes at:dstIndex put:value.
            value := bytes at:(srcIndex + 1).
            newBytes at:(dstIndex + 1) put:value.
            value := bytes at:(srcIndex + 2).
            newBytes at:(dstIndex + 2) put:value.
            dstIndex := dstIndex + 3
        ]
    ].
"
    ^ newImage
! !