Depth24Image.st
changeset 1 304f026e10cd
child 3 c0aaded4ef28
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Depth24Image.st	Wed Oct 13 01:30:35 1993 +0100
@@ -0,0 +1,1100 @@
+'From Smalltalk/X, Version:2.7.1 on 9-Aug-1993 at 20:32:32'!
+
+Image subclass:#Depth24Image
+         instanceVariableNames:''
+         classVariableNames:''
+         poolDictionaries:''
+         category:'Graphics-Display Objects'
+!
+
+!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 (_isNonNilObject(_INST(bytes)) && (_qClass(_INST(bytes)) == ByteArray)
+     && _isNonNilObject(monoBits) && (_qClass(monoBits) == ByteArray)) {
+        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 (_isNonNilObject(_INST(bytes))
+                 && (_qClass(_INST(bytes)) == ByteArray)) {
+                    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
+! !