Image.st
author Claus Gittinger <cg@exept.de>
Mon, 17 Jun 1996 17:32:27 +0200
changeset 878 b99add8dc742
parent 874 cce9c1029d38
child 879 2adf7645e7e6
permissions -rw-r--r--
checkin from browser

"
 COPYRIGHT (c) 1991 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.
"

Object subclass:#Image
	instanceVariableNames:'bytes width height bitsPerSample samplesPerPixel colorMap
		photometric device deviceForm monoDeviceForm fullColorDeviceForm'
	classVariableNames:'Lobby DitherAlgorithm NumberOfDitherColors
		CollectGarbageWhenRunningOutOfColors FileFormats'
	poolDictionaries:''
	category:'Graphics-Images'
!

!Image class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1991 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 provides (some time in the future) representation
    for all kinds of images (monochrome, greyscale and color)
    and will finally replace Form. 
    For now (only ;-) depths of 1, 2, 4, 8, 16 and 24 are supported.

    An Image keeps all of its information in a device independent way, 
    but may be associated to a device. 
    The data held keeps all information which was originally present, 
    even if the display-device has lower resolution.
    Therefore, it is possible to process and manipulate images without loosing 
    color information - even on low color resolution displays.

    Usually, you get a device specific representation of the image by
    sending the 
        'on:aDevice' 
    message to it, which will create a (possibly dithered) device-form, 
    representing the image using the currently available colors.

    In rare cases, an explicit monochrome representation of the image is needed 
    (X servers take monochrome icons only), this can be created by sending
    it the message 
        'monochromeOn:aDevice'.

    Also, it is planned to generate another hi-color resolution version,
    which uses its own colormap and allows the use of all 256 colors on an 8bit display 
    (this is not currently implemented).

    An images pixel interpretation is controlled by the photometric instance variable
    and (if that is #palette) a colorMap.
    This is in contrast to the ST-80 way, where all of this info is in the colorMap
    (and using specialized colorMaps for b&w / greyScale images).
    This may change in future versions for more application compatibility.
 
    To convert pictures from/to external file-formats, image readers are used
    which have the file-format knowledge built in. 
    There are readers for most common formats available 
    (see ImageReader and especially subclasses such as TIFFReader, GIFReader etc.).

    File formats are handled by subclasses of ImageReader, which understand
    a specific format. You can add more readers, by adding an association
    such as ('.jpg' -> JPEGReader) to the class variable 'FileFormats' 
    (see the classes #initialize method, which dsets up some default, and the
    patches/display.rc files, which add more).

    Some algorithms used here (especially dithering & color allocation) are
    experimental and far from being perfect (some are very slow). 
    For now, the most common cases have been optimized and perform reasonably
    fast - however, with uncommon depth/visualType combinations, you may
    run into slower fallback methods ...

    Much more work is needed if you plan to do heavy image processing and will
    (may) be done in the future if there is a demand for it ...
    Dithering can be controlled by the DitherAlgorithm classVariable:

       DitherAlgorithm:

       nil                  a simple threshold algorithm
                            (i.e. for mono, p<0.5 -> black, p>=0.5 -> white)

       #pattern             patterned dither
                            (for p, take dithered color to fill pixel;
                             uses dithering in color-class)

       #error               error diffusion dither (Floyd-Steinberg)
                            planned - not yet implemented.



    [instance variables:]

        width               <Integer>       the width in pixels
        height              <Integer>       the height in pixels
        bytes               <ByteArray>     the full image information
        photometric         <Symbol>        #rgb, #palette, #blackIs0 or #whiteIs0
        samplesPerPixel     <Integer>       the number of planes
        bitsPerSample       <Array>         the number of bits per plane

        colorMap            <Array>         only if photometric is #pseudocolor;
                                            maps pixel values to r/g/b values.

        device              <Workstation>   the device on which deviceForm,
                                            monoDeviceForm and lowResDeviceForm are

        deviceForm          <Form>          the device form which gives the best
                                            possible aproximation of the image on
                                            device using standard colors.

        monoDeviceForm      <Form>          the device form which gives a monochrome
                                            aproximation of the image on device.

        fullColorDeviceForm <Form>          the device form which gives the best
                                            possible aproximation of the image on
                                            device using private colors.

    [class variables:]

        Lobby               <Registry>      keeps track of known images
                                            (for resource freeing with garbage collector)

        DitherAlgorithm     <Symbol>        defines how to dither

        NumberOfDitherColors <Integer>      defines, how many dither colors to use

        FileFormats         <Dictionary>    associates filename extensions to
                                            image reader classes (now set-up in startup-file)

        CollectGarbageWhenRunningOutOfColors
                            <Boolean>       if true, and we run out of available
                                            device colors during creation of a
                                            device image, collect garbage for
                                            possible image reclamation.
                                            If false, proceed immediately.
                                            Default is true.

    todo:
        there is currently no mask stored/available in the image itself; currently masks
        have to be stored as separate bitmaps. 
        (which is bad for image-file formats, which provide a mask)
        Thus, currently, all images are completely opaque.

    [See also:]
        Form Icon ImageReader

    [author:]
        Claus Gittinger
"
!

examples
"
    reading from a file (many formats are supported):
                                                                        [exBegin]
        (Image fromFile:'bitmaps/claus.gif') inspect
                                                                        [exEnd]
                                                                        [exBegin]
        (Image fromFile:'bitmaps/SmalltalkX.xbm') inspect
                                                                        [exEnd]
                                                                        [exBegin]
        (Image fromFile:'bitmaps/okSmily_up.bmp') inspect
                                                                        [exEnd]

    inline image:
      default: depth=1 & #blackIs0
                                                                        [exBegin]
        (Image width:8 height:8
               fromArray:#( 2r11111111
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r11111111 )) inspect
                                                                        [exEnd]

      with #whiteIs0 photometric
                                                                        [exBegin]
        ((Image width:8 height:8
               fromArray:#( 2r11111111
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r11111111 ))
            photometric:#whiteIs0)
                 inspect
                                                                        [exEnd]

      with a colorMap
                                                                        [exBegin]
        ((Image width:8 height:8
               fromArray:#( 2r11111111
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r10000001
                            2r11111111 ))
            colorMap:(Array with:(Color red)
                            with:(Color yellow)))
                 inspect
                                                                        [exEnd]

      a depth4 greyScale image:
                                                                        [exBegin]
        ((Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ])
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]
      the following has the same effect:
                                                                        [exBegin]
        ((Image
             width:4 
             height:4
             depth:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ])
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]
      with reverse grey-interpretation:
                                                                        [exBegin]
        ((Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ])
            photometric:#whiteIs0;
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]

      with 1-bit-per-pixel rgb interpretation:
                                                                        [exBegin]
        ((Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ])
            photometric:#rgb;
            samplesPerPixel:3;
            bitsPerSample:#(1 1 1);
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]

      with 1/2/1 rgb interpretation:
                                                                        [exBegin]
        ((Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ])
            photometric:#rgb;
            samplesPerPixel:3;
            bitsPerSample:#(1 2 1);
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]

      a 2/2/0 rgb image (i.e. no blue):
                                                                        [exBegin]
         |i|

         i := Depth4Image
                    width:4
                    height:4
                    fromArray:#[ 16r01 16r23
                                 16r45 16r67
                                 16r89 16rab
                                 16rcd 16ref ].
         i photometric:#rgb.
         i samplesPerPixel:3.
         i bitsPerSample:#(2 2 0).

         i := i magnifiedBy:30.
         i inspect.
                                                                        [exEnd]


      a 0/0/4 rgb image (i.e. no red or green):
                                                                        [exBegin]
         |i|

         i := Depth4Image
                    width:4
                    height:4
                    fromArray:#[ 16r01 16r23
                                 16r45 16r67
                                 16r89 16rab
                                 16rcd 16ref ].
         i photometric:#rgb.
         i samplesPerPixel:3.
         i bitsPerSample:#(0 0 4).

         i := i magnifiedBy:30.
         i inspect.
                                                                        [exEnd]


      a 2plane greyscale image:
                                                                        [exBegin]
        ((Depth2Image
             width:4 
             height:4
             fromArray:#[ 
                            4r0123
                            4r1230
                            4r2301
                            4r3012 
                        ])
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]

      with colors:
                                                                        [exBegin]
        ((Depth2Image
             width:4 
             height:4
             fromArray:#[ 
                            4r0123
                            4r1230
                            4r2301
                            4r3012 
                        ])
            colorMap:(Array with:(Color black)
                            with:(Color red)
                            with:(Color green)
                            with:(Color blue));
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]

      depth8 image with 3/3/2 rgb interpretation:
                                                                        [exBegin]
        ((Depth8Image
             width:16 
             height:16
             fromArray:(ByteArray withAll:(0 to:16rFF)))
            photometric:#rgb;
            samplesPerPixel:3;
            bitsPerSample:#(3 3 2);
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]

      depth8 image with 2/2/2 rgb interpretation:
                                                                        [exBegin]
        ((Depth8Image
             width:8 
             height:8
             fromArray:(ByteArray withAll:(0 to:16r3F)))
            photometric:#rgb;
            samplesPerPixel:3;
            bitsPerSample:#(2 2 2);
            magnifiedBy:30)
                 inspect
                                                                        [exEnd]

    storing (only a few formats are currently supported):
                                                                        [exBegin]
        |img|

        img := Image fromFile:'bitmaps/okSmily_up.bmp'.
        img saveOn:'myImage.tiff'.
        (Image fromFile:'myImage.tiff') inspect
                                                                        [exEnd]
    magnifying (any factor):
                                                                        [exBegin]
        ((Image fromFile:'bitmaps/claus.gif') 
            magnifiedTo:(48@48))
                inspect
                                                                        [exEnd]
                                                                        [exBegin]
        ((Image fromFile:'bitmaps/claus.gif') 
            magnifiedBy:0.7)
                inspect
                                                                        [exEnd]
    rotating (currently, only multiples of 90 degrees are supported):
                                                                        [exBegin]
        ((Image fromFile:'bitmaps/claus.gif') 
            rotated:90)
                inspect
                                                                        [exEnd]
                                                                        [exBegin]
        (((Image fromFile:'bitmaps/claus.gif') 
            magnifiedBy:0.3@0.7) rotated:270)
                inspect
                                                                        [exEnd]
"
! !

!Image class methodsFor:'initialization'!

fileFormats
    "return the collection of supported file formats.
     The returned dictionary maps file-extensions to image reader classes."

    FileFormats isNil ifTrue:[
	self initializeFileFormatTable
    ].
    ^ FileFormats

    "
     Image fileFormats
    "
!

flushDeviceImages
    "simply release all deviceForms"

    Lobby do:[:anImage |
        anImage restored
    ]

    "Modified: 15.6.1996 / 15:45:02 / cg"
!

initialize
    "initialize class constants"

    "setup tracker of known pictures"
    Lobby isNil ifTrue:[
        Lobby := Registry new.
        ObjectMemory addDependent:self.

        "/ define the algorithm to use for dithering - 
        "/ supported values are:
        "/      #threshold
        "/      #ordered
        "/      #floydSteinberg
        "/      #burkes

        DitherAlgorithm := #floydSteinberg.   

        (Display notNil and:[Display hasGrayscales]) ifFalse:[
            NumberOfDitherColors := 64
        ] ifTrue:[
            "as far as I remember, this is about the number of grey values, the eye can distinguish"
            NumberOfDitherColors := 100
        ].

        "define reader classes"
        FileFormats isNil ifTrue:[
            self initializeFileFormatTable
        ].

        CollectGarbageWhenRunningOutOfColors := false
    ]

    "Modified: 10.6.1996 / 12:28:22 / cg"
!

initializeFileFormatTable
    "initialize a default table to map from file extension to reader class.
     The mapping here is a default needed for proper operation of ST/X;
     see the 'smalltalk.rc' startup file for a real (full) map."

    FileFormats := Dictionary new.
    FileFormats at:'.xbm'  put:XBMReader.
    FileFormats at:'.tiff' put:TIFFReader.
    FileFormats at:'.gif'  put:GIFReader.
"/    FileFormats at:'.img'  put:IMGReader.
"/    FileFormats at:'.icon' put:SunRasterReader.

    "
     Image initializeFileFormatTable
    "
!

update:something
    "flush all device specific stuff when restarted from a snapshot"

    (something == #restarted) ifTrue:[
	self flushDeviceImages
    ]
! !

!Image class methodsFor:'instance creation'!

extent:ext depth:d bits:bits
    "ST-80 compatibility; assume 32-bit padding"

    ^ self extent:ext depth:d bits:bits pad:32
!

extent:ext depth:d bits:bits pad:padding
    "ST-80 compatibility"

    ^ self width:ext x height:ext y depth:d fromArray:bits pad:padding
!

extent:ext depth:d palette:aColormap bits:bits pad:padding
    "ST-80 compatibility"

    ^ self width:ext x height:ext y depth:d fromArray:bits pad:padding
!

extent:ext fromArray:bits offset:offset
    "ST-80 compatibility"

    ^ self width:ext x height:ext y fromArray:bits
!

fromForm:aForm
    "create & return an Image given a form"

    |cls|

    cls := self.
    cls == Image ifTrue:[
	cls := self implementorForDepth:aForm depth
    ].
    ^ (cls new) fromForm:aForm.

    "
     |f|

     f := Form width:16 height:16.
     f clear.
     f displayLineFromX:0 y:0 toX:15 y:15.
     f inspect.
     (Image fromForm:f) inspect
    "
!

fromImage:anImage
    "create & return an Image given another image. This can be used to
     convert an image to another depth."

    (self == Image or:[anImage class == self]) ifTrue:[^ anImage].
    ^ self new fromImage:anImage.

    "
     |i1 i8|

     i1 := Image fromFile:'bitmaps/SBrowser.xbm'.
     i8 := Depth8Image fromImage:i1.
     i8 inspect
    "
!

fromSubImage:anImage in:aRectangle
    "create & return an Image from a rectangular area in another image. 
     This can also be used to get a subimage in another depth."

    |newImage|

    self == Image ifTrue:[
        newImage := self implementorForDepth:anImage depth.
    ] ifFalse:[
        newImage := self new.
    ].
    ^ newImage fromSubImage:anImage in:aRectangle.

    "
     |i1 i8|

     i1 := Image fromFile:'bitmaps/garfield.gif'.
     i8 := Depth8Image fromSubImage:i1 in:(0@0 corner:20@20).
     i8 inspect
    "
    "
     |i1 i8|

     i1 := Image fromFile:'bitmaps/claus.gif'.
     i8 := Depth8Image fromSubImage:i1 in:(70@50 extent:50@50).
     i8 inspect
    "
    "
     |i1 i8|

     i1 := Image fromFile:'bitmaps/claus.gif'.
     i8 := Image fromSubImage:i1 in:(70@50 extent:50@50).
     i8 inspect
    "

    "Created: 20.9.1995 / 01:05:43 / claus"
    "Modified: 10.6.1996 / 18:11:08 / cg"
!

new
    "create a new image. Redefined to set the photometric to
     greyScale with black being 0 as default."

    ^ super new photometric:(self defaultPhotometric)

    "Modified: 10.6.1996 / 18:08:37 / cg"
!

width:w height:h
    "create a new image, given width, height. Assume a depth of 1."

    |cls|

    cls := self.
    cls == Image ifTrue:[
	cls := self implementorForDepth:1
    ].
    ^ cls new width:w height:h depth:1 
!

width:w height:h depth:d
    "create a new image, given width, height and depth"

    ^ (self implementorForDepth:d) new
	width:w height:h depth:d
!

width:w height:h depth:d fromArray:pixelData
    "create a new image, given width, height, depth and data.
     Data must be a ByteArray containing correctly aligned bits for the specified
     depth (8-bit padded)."

    ^ (self implementorForDepth:d) new 
                width:w height:h depth:d fromArray:pixelData

    "
     Image width:8 
           height:8
           depth:1
           fromArray:#[2r11001100
                       2r00110011
                       2r11001100
                       2r00110011
                       2r11001100
                       2r00110011
                       2r11001100
                       2r00110011].
    "

    "
     Image width:8 
           height:8
           depth:2 
           fromArray:#[4r1100 4r1100
                       4r0011 4r0011
                       4r1100 4r1100
                       4r0011 4r0011
                       4r1100 4r1100
                       4r0011 4r0011
                       4r1100 4r1100
                       4r0011 4r0011].
    "

    "
     Image width:8 
           height:8
           depth:4 
           fromArray:#[16r00 16r01 16rf0 16rf1
                       16r02 16r03 16rf2 16rf3
                       16r04 16r05 16rf4 16rf5
                       16r06 16r07 16rf6 16rf7
                       16r08 16r09 16rf8 16rf9
                       16r0a 16r0b 16rfa 16rfb
                       16r0c 16r0d 16rfc 16rfd
                       16r0e 16r0f 16rfe 16rff].
    "

    "Modified: 10.6.1996 / 18:18:10 / cg"
!

width:w height:h depth:d fromArray:pixelData pad:padding
    "create a new image, given width, height, depth and data.
     Data must be a ByteArray containing correctly aligned bits for the specified
     depth."

    |img newBits srcRowBytes dstRowBytes srcIndex dstIndex|

    img := (self implementorForDepth:d) new width:w height:h depth:d .

    padding ~~ 8 ifTrue:[
        "must repad; ST/X uses byte padding, while ST-80 uses longword
         padding. This is stupid, and may be changed in ST/X with future versions.
        "
        dstRowBytes := img bytesPerRow.
        srcRowBytes := ((w * d + padding - 1) bitShift:-5) bitShift:2.

        newBits := ByteArray new:(dstRowBytes * h).
        srcIndex := 1.
        dstIndex := 1.

        1 to:h do:[:row |
            newBits replaceFrom:dstIndex 
                             to:(dstIndex + dstRowBytes - 1)
                           with:pixelData
                     startingAt:srcIndex.
            srcIndex := srcIndex + srcRowBytes.
            dstIndex := dstIndex + dstRowBytes.
        ].
    ] ifFalse:[
        pixelData class isBytes ifFalse:[
            newBits := ByteArray withAll:pixelData
        ] ifTrue:[
            newBits := pixelData
        ]
    ].
    img bits:newBits.
    ^ img

    "Modified: 8.6.1996 / 10:07:47 / cg"
!

width:w height:h fromArray:anArray
    "create a new image, given width, height. Assume a depth of 1 of the
     receiving class is Image.
     Data must be a ByteArray containing correctly aligned bits for depth 1
     (i.e. 8 bits per byte)."

    |cls d pixels|

    cls := self.
    cls == Image ifTrue:[
        cls := self implementorForDepth:1.
        d := 1.
    ] ifFalse:[
        d := cls imageDepth
    ].
    anArray class isBytes ifFalse:[
        pixels := ByteArray withAll:anArray
    ] ifTrue:[
        pixels := anArray
    ].
    ^ cls new width:w height:h depth:d fromArray:pixels

    "
     Image width:8 
           height:8 
           fromArray:#[2r11001100
                       2r00110011
                       2r11001100
                       2r00110011
                       2r11001100
                       2r00110011
                       2r11001100
                       2r00110011].
    "

    "Modified: 8.6.1996 / 10:07:26 / cg"
! !

!Image class methodsFor:'file reading'!

fromFile:aFileName
    "read an image from a file - this methods tries to find
     out the file format itself (by the extension and by contents)
     and lets the appropriate reader read the file."

    |image name nm inStream suffixLen|

    "
     before trying each reader, check if file is readable
    "
    name := aFileName.
    inStream := Smalltalk systemFileStreamFor:name.
    inStream isNil ifTrue:[
        inStream := Smalltalk bitmapFileStreamFor:name.
        inStream isNil ifTrue:[
            ('IMAGE: ' , aFileName , ' does not exist or is not readable') infoPrintCR.
            ^ nil
        ].
        name := 'bitmaps/' , name.
    ].
    inStream close.

    "
     get the imageReader class from the files extension
    "
    nm := name.
    (name endsWith:'.Z') ifTrue:[
        suffixLen := 2
    ] ifFalse:[
        (name endsWith:'.gz') ifTrue:[
            suffixLen := 3
        ] ifFalse:[
            suffixLen := 0
        ]
    ].
    suffixLen ~~ 0 ifTrue:[
        nm := name copyWithoutLast:suffixLen
    ].

    "
     ask the corresponding readerclass first
    "
    FileFormats keysAndValuesDo:[:suffix :readerClass |
        (nm endsWith:suffix) ifTrue:[
            readerClass notNil ifTrue:[
                image := readerClass fromFile:name.
                image notNil ifTrue:[^ image].
            ]
        ]
    ].

    "
     no known extension - ask all readers if they know
     this format ...
    "
    FileFormats do:[:readerClass |
        readerClass notNil ifTrue:[
            (readerClass isValidImageFile:name) ifTrue:[
                ^ readerClass fromFile:name 
            ]
        ]
    ].

    "
     nope - unknown format
    "
    'IMAGE: unknown image file format: ' infoPrint. aFileName infoPrintNL.
    ^ nil

    "
     Image fromFile:'bitmaps/dano.tiff'
     Image fromFile:'bitmaps/test.fax'
     Image fromFile:'bitmaps/voice.tiff'
     Image fromFile:'voice.tiff'

     Image fromFile:'../fileIn/bitmaps/claus.gif'
     Image fromFile:'../fileIn/bitmaps/garfield.gif'

     Image fromFile:'../fileIn/bitmaps/founders.im8'
     Image fromFile:'../goodies/faces/next.com/steve.face'

     Image fromFile:'/LocalLibrary/Images/OS2/dos3.ico'
     Image fromFile:'bitmaps/globe1.xbm'
     Image fromFile:'bitmaps/globe1.xbm.Z'
     Image fromFile:'bitmaps/hello_world.icon'
    "

    "Modified: 10.6.1996 / 14:36:18 / cg"
! !

!Image class methodsFor:'misc'!

dither:aSymbol
    "define how to dither - 
        #threshold, or nil        -> no dither
        #pattern, or #ordered     -> orderedDither (ugly, but fast)
        #error or #floydSteinberg -> errorDiffusion; much better
        #burkes                   -> errorDiffusion; even better."

    DitherAlgorithm := aSymbol

    "
     Image dither:#pattern
     Image dither:#floydSteinberg
     Image dither:#burkes
     Image dither:nil
    "

    "Modified: 10.6.1996 / 12:27:09 / cg"
!

numberOfDitherColors:n
    "define how many colors (i.e. patterns) to use when
     doing a pattern dither"

    NumberOfDitherColors := n
!

orderedDitherMatrixOfSize:sz
    sz == 2 ifTrue:[
        ^ #[
                0 2 
                3 1
           ].
    ].

    sz == 4 ifTrue:[
        ^ #[
                 0  8  2 10
                12  4 14  6
                 3 11  1  9
                15  7 13  5
           ].
    ].

    sz == 8 ifTrue:[
        ^  #[
                0 32  8 40    2 34 10 42
               48 16 56 24   50 18 58 26
               12 44  4 36   14 46  6 38    
               60 28 52 20   62 30 54 22

                3 35 11 43    1 33  9 41
               51 19 59 27   49 17 57 25
               15 47  7 39   13 45  5 37    
               63 31 55 23   61 29 53 21
            ].
    ].

    ^ nil

    "Created: 7.6.1996 / 14:15:05 / cg"
! !

!Image class methodsFor:'queries'!

defaultPhotometric
    "return the default photometric pixel interpretation"

    ^ #blackIs0

    "Modified: 20.4.1996 / 23:40:41 / cg"
    "Created: 10.6.1996 / 18:08:12 / cg"
!

imageDepth
    "return the depth of images represented by instances of
     this class.
     Must be redefined in concrete subclasses"

    ^ self shouldNotImplement

    "Modified: 20.4.1996 / 23:40:41 / cg"
!

implementorForDepth:depth
    "return the class, which best implements images of depth"

    depth == 1 ifTrue:[^ Depth1Image].
    depth == 2 ifTrue:[^ Depth2Image].
    depth == 4 ifTrue:[^ Depth4Image].
    depth == 8 ifTrue:[^ Depth8Image].
    depth == 15 ifTrue:[^ Depth16Image].  "/ kludge for 15bit XFree
    depth == 16 ifTrue:[^ Depth16Image].
    depth == 24 ifTrue:[^ Depth24Image].
    ^ self
! !

!Image class methodsFor:'screen capture'!

fromScreen
    "return an image of the full screen"

    |display|

    display := Screen current.
    ^ self fromScreen:(0@0 corner:(display width @ display height))

    "
     Image fromScreen
    "
!

fromScreen:aRectangle
    "return an image of a part of the screen"

    ^ self fromScreen:aRectangle on:Screen current 

    "
     Image fromScreen:(0@0 corner:100@100)
    "
!

fromScreen:aRectangle on:aDisplay
    "return an image of a part of the screen, which may be on
     another Display."

    |depth vis img|

    depth := aDisplay depth.

    "/
    "/ for truecolor displays, return a Depth24Image
    "/ (must do this for depth15 & depth16 displays, since
    "/  Depth16Image has no way to specify r/g/b masks ...)
    "/
    vis := aDisplay visualType.
    (vis == #TrueColor or:[vis == #DirectColor]) ifTrue:[
	depth > 8 ifTrue:[
	    depth := 24.
	]
    ].

    img := (self implementorForDepth: depth) new.
    ^ img fromScreen:aRectangle on:aDisplay

    "
     Image fromScreen:(0@0 corner:100@100)
    "
!

fromScreenArea
    "return an image of a part of the screen; 
     let user specify screen area."

    ^ self fromScreen:(Rectangle fromUser)

    "
     Image fromScreenArea
    "
!

fromUser
    "return an image of a part of the screen; let user specify screen area.
     Same as fromScreenArea, for ST-80 compatibility"

    ^ self fromScreenArea

    "
     Image fromUser
    "
!

fromView:aView
    "return an image taken from a views contents as currently
     on the screen. The returned image has the same depth and photometric
     as the Display. Notice, that for invisible or partial covered
     views, the returned Image is NOT correct. You may want to raise
     the view before using this method."

    |org dev|

    dev := aView graphicsDevice.
    org := dev translatePoint:(0@0)
                         from:(aView id)
                           to:dev rootWindowId.
    ^ self fromScreen:(org extent:aView extent) on:dev

    "
     Image fromView:(NewLauncher allInstances first topView)
     Image fromView:(SystemBrowser allInstances first topView)
    "

    "Modified: 28.5.1996 / 20:23:32 / cg"
! !

!Image methodsFor:'accessing'!

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

    bitsPerSample notNil ifTrue:[^ bitsPerSample].
    ^ Array with:self depth

    "Modified: 10.6.1996 / 18:04:21 / cg"
!

colorMap
    "return the colormap"

    ^ colorMap
!

colorMap:aColorMap
    "set the colorMap; this also set the photometric to a useful defualt."

    |sz "{ Class: SmallInteger }"
     sameColors|

    (aColorMap isNil and:[colorMap isNil]) ifTrue:[^ self].
    photometric == #palette ifTrue:[
        "/ any change at all ?
        (sz := aColorMap size) == colorMap size ifTrue:[
            sameColors := true.

            1 to:sz do:[:idx |
                (aColorMap at:idx) = (colorMap at:idx) ifFalse:[
                    sameColors := false.
                ]
            ].
            sameColors ifTrue:[^ self].
        ]
    ].

    colorMap := aColorMap.
    colorMap notNil ifTrue:[
        photometric := #palette.
    ] ifFalse:[
        (photometric == #palette) ifTrue:[
            photometric := #blackIs0
        ]
    ].
    deviceForm notNil ifTrue:[
        self release
    ]

    "Modified: 31.8.1995 / 03:05:59 / claus"
    "Modified: 15.6.1996 / 09:32:09 / cg"
!

container:aVisualContainer
    "ignored here - added to allow images to be used like
     VisualComponents (later, Image should inherit from it)"

    "Created: 28.5.1996 / 23:43:49 / cg"
    "Modified: 29.5.1996 / 10:22:23 / cg"
!

depth
    "return the depth of the image"

    ^ self bitsPerPixel
!

device
    "return the device, the receiver is associated with.
     Return nil, if the image is unassigned."

    ^ device
!

extent
    "return the images extent"

    ^ width@height
!

fullColorId
    "return the id of the full color image on the device.
     Return nil, if the image is unassigned."

    fullColorDeviceForm isNil ifTrue:[^ nil].
    ^ fullColorDeviceForm id
!

graphicsDevice
    "same as #device - for ST-80 compatibility"

    ^ device
!

height
    "return the height of the image"

    ^ height
!

id
    "return the id of the image on the device.
     Return nil, if the image is unassigned."

    deviceForm isNil ifTrue:[^ nil].
    ^ deviceForm id
!

monochromeId
    "return the id of the monochrome image on the device.
     Return nil, if the image is unassigned."

    monoDeviceForm isNil ifTrue:[^ nil].
    ^ monoDeviceForm id
!

palette 
    "return the colormap; ST-80 compatibility"

    ^ colorMap
!

palette:aColormap 
    "set the colormap; ST-80 compatibility"

    self colorMap:aColormap

    "Created: 1.2.1996 / 15:09:25 / cg"
    "Modified: 8.6.1996 / 09:54:02 / cg"
!

photometric
    "return the photometric, a symbol such as #palette, #rgb etc."

    ^ photometric
!

samplesPerPixel
    "return the number of samples per pixel in the image.
     The return value is an array of bits-per-plane."

    samplesPerPixel notNil ifTrue:[^ samplesPerPixel].
    ^ 1

    "Modified: 10.6.1996 / 18:03:30 / cg"
!

width
    "return the width of the image"

    ^ width
! !

!Image methodsFor:'accessing - pixels'!

at:aPoint
    "retrieve the pixel at aPoint; return a color.
     Pixels start at 0@0 for upper left pixel, end at
     (width-1)@(height-1) for lower right pixel.
     You should not use this method for image-processing, its
     very slow ...
     (it is meant to access individual pixels - for example, in a bitmap editor)"

    ^ self atX:aPoint x y:aPoint y
!

at:aPoint put:aColor
    "set the pixel at aPoint to aColor.
     Pixels start at 0@0 for the upper left pixel, end at
     (width-1)@(height-1) for lower right pixel.
     You should not use this method for image-processing, its
     very slow ...
     (it is meant to access individual pixels - for example, in a bitmap editor)"

    ^ self atX:aPoint x y:aPoint y put:aColor
!

atPoint:aPoint
    "ST-80 compatibility: return the pixelValue at:aPoint."

    ^ self valueAtX:aPoint x y:aPoint y
!

atX:x y:y
    "retrieve a pixel at x/y; return a color.
     Pixels start at 0@0 for upper left pixel, end at
     (width-1)@(height-1) for lower right pixel.
     You should not use this method for image-processing, its
     very slow ...
     (it is meant to access individual pixels - for example, in a bitmap editor)"

    |pixel maxPixel|

    pixel := self valueAtX:x y:y.
    photometric == #blackIs0 ifTrue:[
        maxPixel := (1 bitShift:self bitsPerPixel) - 1.
        ^ Color gray:(pixel * (100 / maxPixel)).
    ].
    photometric == #whiteIs0 ifTrue:[
        maxPixel := (1 bitShift:self bitsPerPixel) - 1.
        ^ Color gray:100 - (pixel * (100 / maxPixel)).
    ].
    photometric == #palette ifTrue:[
        ^ colorMap at:(pixel + 1)
    ].

    ^ self colorFromValue:pixel

    "Modified: 8.6.1996 / 10:53:22 / cg"
!

atX:x y:y put:aColor
    "set the pixel at x/y to aColor.
     Pixels start at 0@0 for the upper left pixel, end at
     (width-1)@(height-1) for the lower right pixel.
     This method checks if the color can be stored in the image.
     (i.e. if the receiver is a palette image, the color must be present in there).
     You should not use this method for image-processing, it is very slow ...
     (it is meant to access individual pixels - for example, in a bitmap editor)"

    |pixel maxPixel|

    photometric == #whiteIs0 ifTrue:[
        maxPixel := (1 bitShift:self bitsPerPixel) - 1.
        pixel := maxPixel - (aColor brightness * maxPixel) rounded.
    ] ifFalse:[
        photometric == #blackIs0 ifTrue:[
            maxPixel := (1 bitShift:self bitsPerPixel) - 1.
            pixel := (aColor brightness * maxPixel) rounded.
        ] ifFalse:[
            photometric ~~ #palette ifTrue:[
                self error:'format not supported'.
                ^ nil
            ].
            pixel := colorMap indexOf:aColor.
            pixel == 0 ifTrue:[
                "
                 the color to be stored is not in the images colormap
                "
                self error:'invalid color - not in colorMap'
            ].
            pixel := pixel - 1
        ]
    ].
    self atX:x y:y putValue:pixel.

    "Modified: 7.6.1996 / 19:17:48 / cg"
!

atX:x y:y putValue: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 0@0 for the upper left pixel, end at
     (width-1) @ (height-1) for the lower right pixel.
     You should not use this method for image-processing, its
     very slow ...
     (it is meant to access individual pixels - for example, in a bitmap editor)"

    ^ self subclassResponsibility
!

bits
    "return the raw image data; depending on the photometric,
     this has to be interpreted as monochrome, greyscale,
     palette or rgb data. It is also packed to be dense, so
     a 4 bitPerSample palette image will store 2 pixels per byte."

    ^ bytes
!

data
    "for backward compatibility - will vanish"

    ^ bytes
!

data:aByteArray
    "for backward compatibility - will vanish"

    bytes := aByteArray
!

valueAt:aPoint
    "retrieve the pixelValue at aPoint; return an integer number.
     Pixels start at 0@0 for upper left pixel, end at
     width-1@height-1 for lower right pixel.
     The returned numbers interpretation depends on the photometric
     and the colormap. (see also Image>>at: and Image>>atX:y:)
     You should not use this method for image-processing, its
     very slow ...
     (it is meant to access individual pixels - for example, in a bitmap editor)"

    ^ self valueAtX:aPoint x y:aPoint y
!

valueAtX:x y:y
    "retrieve the pixelValue at aPoint; return an integer number.
     Pixels start at 0/0 for upper left pixel, and end at
     width-1@height-1 for lower right pixel.
     The returned numbers interpretation depends on the photometric
     and the colormap. (see also Image>>at: and Image>>atX:y:)
     You should not use this method for image-processing of
     big images, its very slow ... 
     (it is meant to access individual pixels - for example, in a bitmap editor)"

    ^ self subclassResponsibility
! !

!Image methodsFor:'accessing - private'!

bits:aByteArray
    "set the raw data.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    bytes := aByteArray

    "Modified: 23.4.1996 / 11:08:28 / cg"
!

bitsPerSample:aNumber
    "set the number of bits per sample. 

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    bitsPerSample := aNumber

    "Modified: 23.4.1996 / 11:08:31 / cg"
!

depth:d
    "set the depth of the image.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    d == 24 ifTrue:[
        samplesPerPixel := 3.
        bitsPerSample := #(8 8 8)
    ] ifFalse:[
        samplesPerPixel := 1.
        bitsPerSample := Array with:d 
    ]

    "Modified: 23.4.1996 / 11:08:34 / cg"
!

extent:anExtent
    "set the images extent.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    width := anExtent x.
    height := anExtent y

    "Modified: 23.4.1996 / 11:08:38 / cg"
!

height:aNumber
    "set the height of the image.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    height := aNumber

    "Modified: 23.4.1996 / 11:08:40 / cg"
!

photometric:aSymbol
    "set the photometric interpretation of the pixel values.
     The argument, aSymbol is one of:
        #blackIs0, #whiteIs0, #palette, #rgb
     See TIFF documentation, from which the photometric concept is borrowed.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    |b|

    photometric := aSymbol.
    bitsPerSample isNil ifTrue:[
        photometric == #rgb ifTrue:[
            b := self class imageDepth // 3.
            bitsPerSample := Array with:b with:b with:b
        ] ifFalse:[
            bitsPerSample := Array with:(self class imageDepth)
        ].
    ].
    samplesPerPixel isNil ifTrue:[
        photometric == #rgb ifTrue:[
            samplesPerPixel := 3
        ] ifFalse:[
            samplesPerPixel := 1
        ]
    ].

    "Modified: 10.6.1996 / 18:21:29 / cg"
!

samplesPerPixel:aNumber
    "set the array of samples per pixel.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    samplesPerPixel := aNumber

    "Modified: 23.4.1996 / 11:08:45 / cg"
!

width:aNumber
    "set the width of the image.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    width := aNumber

    "Modified: 23.4.1996 / 11:08:48 / cg"
!

width:w height:h 
    "set the width and height of the image.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    width := w.
    height := h

    "Modified: 23.4.1996 / 11:08:53 / cg"
!

width:w height:h depth:d
    "set the width, height and depth of the image.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    width := w.
    height := h.
    self depth:d.

    "Modified: 23.4.1996 / 11:08:56 / cg"
!

width:w height:h depth:d fromArray:bits
    "set the width, height, depth and pixels of the image.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    width := w.
    height := h.
    self depth:d.
    bytes := bits

    "Modified: 23.4.1996 / 11:08:59 / cg"
!

width:w height:h photometric:p samplesPerPixel:spp bitsPerSample:bps colorMap:cm bits:pixels
    "set all relevant internal state of the image.

     This interface is only to be used when initializing
     instances or by image readers. Calling for a change of an
     existing image may confuse later pixel interpretation."

    width := w.
    height := h.
    photometric := p.
    samplesPerPixel := spp.
    bitsPerSample := bps.
    colorMap := cm.
    bytes := pixels.

    "Created: 23.4.1996 / 11:06:40 / cg"
    "Modified: 23.4.1996 / 11:09:02 / cg"
! !

!Image methodsFor:'binary storage'!

readBinaryContentsFrom: stream manager: manager
    "read a binary representation of an image from stream.
     Redefined to flush any device data."

    super readBinaryContentsFrom: stream manager: manager.
    device := nil.
    deviceForm := nil.
    monoDeviceForm := nil.
    fullColorDeviceForm := nil.
!

storeBinaryDefinitionOn: stream manager: manager
    "store a binary representation of the receiver on stream.
     This is an internal interface for binary storage mechanism.
     Redefined to not store the device form (which is recreated at
     load time anyway)"

    |tDevice tDeviceForm tMonoDeviceForm tFullColorDeviceForm|

    tDevice := device.
    tDeviceForm := deviceForm.
    tMonoDeviceForm := monoDeviceForm.
    tFullColorDeviceForm := fullColorDeviceForm.

    device := nil.
    deviceForm := nil.
    monoDeviceForm := nil.
    fullColorDeviceForm := nil.

    super storeBinaryDefinitionOn: stream manager: manager.

    device := tDevice.
    deviceForm := tDeviceForm.
    monoDeviceForm := tMonoDeviceForm.
    fullColorDeviceForm := tFullColorDeviceForm.

    "Modified: 23.4.1996 / 09:30:50 / cg"
! !

!Image methodsFor:'converting'!

asBurkesDitheredMonochromeImage
    "return a burkes dithered monochrome image from the receiver image.
     Depending on the images contents, this may or may not look better than
     a floyd-steinberg dithered image.
     Notice, that floyd-steinberg dithering is faster; both because less
     error diffusion is done and due to being specially tuned."

    |monoBits|

    monoBits := self burkesDitheredMonochromeBits.
    ^ Depth1Image width:width height:height fromArray:monoBits

    "
     |i|

     i := Image fromFile:'garfield.gif'.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Image fromFile:'claus.gif'.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ].
     i := i magnifiedBy:30.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "Created: 10.6.1996 / 12:34:44 / cg"
    "Modified: 12.6.1996 / 13:58:16 / cg"
!

asCachedImage
    "return the receiver associated to the current screens device.
     For ST-80 compatibility 
     (ST/X uses Image for both device- and nonDevice-images)"

    ^ self on:Screen current

    "Modified: 23.4.1996 / 11:10:32 / cg"
!

asErrorDitheredMonochromeImage
    "return an error-diffusion dithered monochrome image from the receiver image."

    DitherAlgorithm == #burkes ifTrue:[
        ^ self asBurkesDitheredMonochromeImage
    ].
    DitherAlgorithm == #stevensonArce ifTrue:[
        ^ self asStevensonArgceDitheredMonochromeImage
    ].
    ^ self asFloydSteinbergDitheredMonochromeImage

    "
     |i|

     i := Image fromFile:'garfield.gif'.
     i inspect.
     i asErrorDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Image fromFile:'claus.gif'.
     i inspect.
     i asErrorDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ].
     i := i magnifiedBy:30.
     i inspect.
     i asErrorDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "Modified: 10.6.1996 / 14:22:30 / cg"
!

asFloydSteinbergDitheredDepth8FormOn:aDevice colors:fixColors nRed:nRed nGreen:nGreen nBlue:nBlue 
    "return a floyd-steinberg dithered pseudoForm from the palette picture. 
     Use the colors in the fixColors array, which must be fixR x fixG x fixB
     colors assigned to aDevice, such as the preallocated colors of the
     Color class. 
     By passing the ditherColors as extra array, this method can
     also be used to dither an 8bit image into a smaller number of colors,
     for example to create dithered Depth4Images from Depth8Images."

    |pseudoBits f has8BitImage deviceDepth
     map |

    deviceDepth := aDevice depth.
    deviceDepth == 8 ifTrue:[
        has8BitImage := true.
    ] ifFalse:[
        has8BitImage := false.
        aDevice supportedImageFormats do:[:fmt |
            (fmt at:#bitsPerPixel) == 8 ifTrue:[
                has8BitImage := true.
            ]
        ]
    ].
    has8BitImage ifFalse:[^ nil].

    pseudoBits := self floydSteinbergDitheredDepth8BitsColors:fixColors nRed:nRed nGreen:nGreen nBlue:nBlue.
    pseudoBits isNil ifTrue:[^ nil].

    f := Form width:width height:height depth:deviceDepth on:aDevice.
    f isNil ifTrue:[^ nil].

    "/
    "/ have to create a funny colorMap, where
    "/ color at:index == color colorId:index
    "/
    map := Array new:256.
    fixColors do:[:clr |
        map at:clr colorId + 1 put:clr
    ].
    f colorMap:map. 
    f initGC.
    f bits:pseudoBits.
    aDevice drawBits:pseudoBits bitsPerPixel:8 depth:deviceDepth  
               width:width height:height
                   x:0 y:0
                into:(f id) x:0 y:0 
               width:width height:height with:(f gcId).
    ^ f

    "
     example: 
        color reduction from Depth8 to Depth4 (dithering) can be done by:

     |img8 reducedImg8 img4 map form|

     map := #( 
                  (0     0   0)
                  (0     0 100)
                  (0    50   0)
                  (0    50 100)
                  (0   100   0)
                  (0   100 100)
                  (100   0   0)
                  (100   0 100)
                  (100  50   0)
                  (100  50 100)
                  (100 100   0)
                  (100 100 100)) collect:[:rgb | (Color red:(rgb at:1)
                                                      green:(rgb at:2)
                                                       blue:(rgb at:3)) on:Display].

     img8 := Image fromFile:'bitmaps/bf.im8'.
     form := img8 paletteImageAsDitheredPseudoFormOn:Display 
                      colors:map 
                        nRed:2
                      nGreen:3
                       nBlue:2.
     img8 := Depth8Image fromForm:form.    'dithered version of original image'.
     img4 := Depth4Image fromImage:img8.
    "

    "Modified: 14.6.1996 / 16:52:34 / cg"
!

asFloydSteinbergDitheredGrayFormOn:aDevice
    "return a dithered depth-x grey form from the receiver image."

    |f depth bits|

    depth := aDevice depth.
    depth == 1 ifTrue:[
        "/ for monochrome, there is specialized
        "/ monochrome dither code available

        bits := self floydSteinbergDitheredMonochromeBits.
    ] ifFalse:[
        bits := self floydSteinbergDitheredBitsDepth:depth.
    ].

    ^ self makeDeviceGrayPixmapOn:aDevice depth:depth fromArray:bits

    "
     |i f|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asFloydSteinbergDitheredGrayFormOn:Display) inspect
    "

    "
     |i f|

     i := Image fromFile:'bitmaps/granite.tiff'.
     (i asFloydSteinbergDitheredGrayFormOn:Display) inspect
    "

    "Created: 10.6.1996 / 14:11:39 / cg"
    "Modified: 12.6.1996 / 20:04:48 / cg"
!

asFloydSteinbergDitheredGrayImageDepth:depth
    "return a floyd-steinberg dithered image from the receiver image."

    |ditheredBits|

    depth == 1 ifTrue:[
        ^ self asFloydSteinbergDitheredMonochromeImage
    ].

    ditheredBits := self floydSteinbergDitheredBitsDepth:depth.
    ^ (self class implementorForDepth:depth)
        width:width height:height fromArray:ditheredBits

    "
     |i|

     i := Image fromFile:'garfield.gif'.
     i inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:1) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:2) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:4) inspect.
    "

    "
     |i|

     i := Depth24Image width:4 height:1
          fromArray:#[ 
            16rFF 16r00 16r00   16rFF 16r00 16r00  16rFF 16r00 16r00  16rFF 16r00 16r00
            16rFF 16r00 16r00   16rFF 16r00 16r00  16rFF 16r00 16r00  16rFF 16r00 16r00
            16rFF 16r00 16r00   16rFF 16r00 16r00  16rFF 16r00 16r00  16rFF 16r00 16r00
            16rFF 16r00 16r00   16rFF 16r00 16r00  16rFF 16r00 16r00  16rFF 16r00 16r00].
     i := i magnifiedBy:4@1.
     i inspect.

     (i asFloydSteinbergDitheredGrayImageDepth:1) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:2) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:4) inspect.
    "

    "
     |i|

     i := Depth24Image width:4 height:6
          fromArray:#[ 
            16r00 16r00 16r00   16r00 16r00 16r80  16r00 16r00 16rff  16r00 16r80 16r00
            16r00 16r80 16r80   16r00 16rFF 16r00  16r00 16rFF 16r80  16r00 16rFF 16rFF
            16r80 16r00 16r00   16r80 16r00 16r80  16r80 16r00 16rff  16r80 16r80 16r00
            16r80 16r80 16r80   16r80 16rFF 16r00  16r80 16rFF 16r80  16r80 16rFF 16rFF
            16rFF 16r00 16r00   16rFF 16r00 16r80  16rFF 16r00 16rff  16rFF 16r80 16r00
            16rFF 16r80 16r80   16rFF 16rFF 16r00  16rFF 16rFF 16r80  16rFF 16rFF 16rFF].
     i := i magnifiedBy:30.
     i inspect.

     (i asFloydSteinbergDitheredGrayImageDepth:1) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:2) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:4) inspect.
    "
    "
     |i|

     i := Image fromFile:'granite.tiff'.
     i inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:1) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:2) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:4) inspect.
    "

    "
     |i|

     i := Image fromFile:'claus.gif'.
     i inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:1) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:2) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:4) inspect.
    "

    "
     |i|

     i := Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ].
     i := i magnifiedBy:30.
     i inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:1) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:2) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:4) inspect.
    "

    "Created: 10.6.1996 / 12:33:47 / cg"
    "Modified: 11.6.1996 / 00:16:17 / cg"
!

asFloydSteinbergDitheredMonochromeFormOn:aDevice
    "return a dithered moncohrome form from the receiver image."

    |monoBits clr0 clr1|

    monoBits := self floydSteinbergDitheredMonochromeBits.
    ^ self makeDeviceMonochromeBitmapOn:aDevice fromArray:monoBits

    "
     |i f|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asFloydSteinbergDitheredMonochromeFormOn:Display) inspect.
    "

    "
     |i f|

     i := Depth2Image width:8 height:8
          fromArray:#[
                        4r0000 4r0000
                        4r0000 4r0000
                        4r1111 4r1111
                        4r1111 4r1111
                        4r2222 4r2222
                        4r2222 4r2222
                        4r3333 4r3333
                        4r3333 4r3333
                     ].
     (i asFloydSteinbergDitheredMonochromeFormOn:Display) inspect.
    "

    "Created: 10.6.1996 / 14:11:39 / cg"
    "Modified: 10.6.1996 / 20:18:01 / cg"
!

asFloydSteinbergDitheredMonochromeImage
    "return a floyd-steinberg dithered monochrome image from the receiver image."

    |monoBits|

    monoBits := self floydSteinbergDitheredMonochromeBits.
    ^ Depth1Image width:width height:height fromArray:monoBits

    "
     |i|

     i := Image fromFile:'garfield.gif'.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Image fromFile:'claus.gif'.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ].
     i := i magnifiedBy:30.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "Created: 10.6.1996 / 12:33:47 / cg"
    "Modified: 10.6.1996 / 17:45:48 / cg"
!

asFloydSteinbergDitheredPseudoFormUsing:colors on:aDevice
    "return a floyd-steinberg dithered pseudoForm from the picture,
     using colors in colors for dithering."

    |pseudoBits f has8BitImage deviceDepth
     map |

    deviceDepth := aDevice depth.
    deviceDepth == 8 ifTrue:[
        has8BitImage := true.
    ] ifFalse:[
        has8BitImage := false.
        aDevice supportedImageFormats do:[:fmt |
            (fmt at:#bitsPerPixel) == 8 ifTrue:[
                has8BitImage := true.
            ]
        ]
    ].
    has8BitImage ifFalse:[^ nil].

    pseudoBits := self floydSteinbergDitheredDepth8BitsColors:colors.
    pseudoBits isNil ifTrue:[^ nil].

    f := Form width:width height:height depth:deviceDepth on:aDevice.
    f isNil ifTrue:[^ nil].

    "/
    "/ have to create a funny colorMap, where
    "/ color at:index == color colorId:index
    "/
    map := Array new:256 withAll:0.
    colors do:[:clr |
        clr notNil ifTrue:[
            map at:clr colorId + 1 put:clr
        ]
    ].
    f colorMap:map. 
    f initGC.
    f bits:pseudoBits.
    aDevice drawBits:pseudoBits bitsPerPixel:8 depth:deviceDepth  
               width:width height:height
                   x:0 y:0
                into:(f id) x:0 y:0 
               width:width height:height with:(f gcId).
    ^ f

    "
     |i|

     i := Image fromFile:'bitmaps/garfield.gif'.
     (i asFloydSteinbergDitheredPseudoFormUsing:(Smalltalk at:#'Color:DitherColors') on:Display) inspect


     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asFloydSteinbergDitheredPseudoFormUsing:(Smalltalk at:#'Color:DitherColors') on:Display) inspect
    "

    "Created: 17.6.1996 / 12:13:35 / cg"
    "Modified: 17.6.1996 / 12:45:21 / cg"
!

asFormOn:aDevice
    "get a device form, with best possible approximation.
     remember it in case someone asks again."

    |form|

    ((aDevice == device) and:[deviceForm notNil]) ifTrue:[^ deviceForm].

    aDevice depth == 1 ifTrue:[
        ^ self asMonochromeFormOn:aDevice
    ].

    (aDevice visualType == #StaticGray) ifTrue:[
        ^ self asGrayFormOn:aDevice
    ].

    (aDevice visualType == #PseudoColor) ifTrue:[
        form := self asPseudoFormQuickOn:aDevice.
        form notNil ifTrue:[
            ^ form
        ].
    ].

    (photometric == #palette) ifTrue:[
        form := self paletteImageAsFormOn:aDevice
    ] ifFalse:[
        (photometric == #rgb) ifTrue:[
            form := self rgbImageAsFormOn:aDevice
        ] ifFalse:[
            form := self greyImageAsFormOn:aDevice
        ]
    ].

    (device isNil or:[aDevice == device]) ifTrue:[
        "remember this form in the receiver ..."

        form notNil ifTrue:[
            deviceForm := form.
            device isNil ifTrue:[
                device := aDevice.
                Lobby register:self
            ] ifFalse:[
                Lobby registerChange:self
            ].
            "
             can save space, by not keeping the images data-bits
             twice (here and in the device form)
            "
            form forgetBits
        ]
    ].

    ^ form

    "Modified: 17.6.1996 / 10:41:02 / cg"
!

asGrayFormOn:aDevice
    "get a gray device form"

    ^ self asGrayFormOn:aDevice dither:DitherAlgorithm.

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asGrayFormOn:Display) inspect.
    "

    "Modified: 10.6.1996 / 17:39:30 / cg"
    "Created: 10.6.1996 / 18:44:42 / cg"
!

asGrayFormOn:aDevice dither:aDitherAlgorithm
    "get a greyscale device form, using aDitherAlgorithm."

    |grayBits depth|

    depth := aDevice depth.
    depth == 1 ifTrue:[
        ^ self asMonochromeFormOn:aDevice
    ].

    (aDitherAlgorithm isNil
    or:[aDitherAlgorithm == #threshold]) ifTrue:[
        ^ self asThresholdGrayFormOn:aDevice
    ].

    (aDitherAlgorithm == #pattern
    or:[aDitherAlgorithm == #ordered]) ifTrue:[
        ^ self asOrderedDitheredGrayFormOn:aDevice
    ].

    ^ self asFloydSteinbergDitheredGrayFormOn:aDevice.

    "Created: 10.6.1996 / 18:42:01 / cg"
    "Modified: 14.6.1996 / 15:17:28 / cg"
!

asGrayImageDepth:depth
    "get a gray image from the receiver"

    ^ self asGrayImageDepth:depth dither:DitherAlgorithm.

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asGrayFormOn:Display) inspect.
    "

    "Modified: 10.6.1996 / 17:39:30 / cg"
    "Created: 10.6.1996 / 19:07:08 / cg"
!

asGrayImageDepth:depth dither:aDitherAlgorithm
    "get a greyscale image, using aDitherAlgorithm."

    |grayBits|

    (aDitherAlgorithm isNil
    or:[aDitherAlgorithm == #threshold]) ifTrue:[
        ^ self asThresholdGrayImageDepth:depth
    ].

    (aDitherAlgorithm == #pattern
    or:[aDitherAlgorithm == #ordered]) ifTrue:[
        ^ self asOrderedDitheredGrayImageDepth:depth
    ].

    ^ self asFloydSteinbergDitheredGrayImageDepth:depth

    "Created: 10.6.1996 / 19:08:21 / cg"
!

asMonochromeFormOn:aDevice
    "get a monochrome device form"

    |form|

    ((aDevice == device) and:[monoDeviceForm notNil]) ifTrue:[^ monoDeviceForm].

    form := self asMonochromeFormOn:aDevice dither:DitherAlgorithm.

    (device isNil or:[aDevice == device]) ifTrue:[
        "remember this form in the receiver ..."

        form notNil ifTrue:[
            monoDeviceForm := form.
            device isNil ifTrue:[
                device := aDevice.
                Lobby register:self
            ] ifFalse:[
                Lobby registerChange:self
            ].
            "
             can save space, by not keeping the images data-bits
             twice (here and in the device form)
            "
            form forgetBits
        ]
    ].

    ^ form

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asMonochromeFormOn:Display) inspect.
    "

    "Modified: 10.6.1996 / 17:39:30 / cg"
!

asMonochromeFormOn:aDevice dither:aDitherAlgorithm
    "get a monochrome device form, using aDitherAlgorithm."

    |monoBits clr0 clr1 mustInvert|

    (aDitherAlgorithm isNil
    or:[aDitherAlgorithm == #threshold]) ifTrue:[
        ^ self asThresholdMonochromeFormOn:aDevice
    ].

    aDitherAlgorithm == #burkes ifTrue:[
        monoBits := self burkesDitheredMonochromeBits.
    ] ifFalse:[
        aDitherAlgorithm == #stevensonArce ifTrue:[
            monoBits := self stevensonArceDitheredMonochromeBits.
        ] ifFalse:[
            (aDitherAlgorithm == #pattern
            or:[aDitherAlgorithm == #ordered]) ifTrue:[
                ^ self asOrderedDitheredGrayFormOn:aDevice.
            ] ifFalse:[
                ^ self asFloydSteinbergDitheredMonochromeFormOn:aDevice.
            ]
        ]
    ].

    "/
    "/ make its pixel interpretation correct for the device
    "/
    ^ self makeDeviceMonochromeBitmapOn:aDevice fromArray:monoBits

    "Modified: 10.6.1996 / 20:18:05 / cg"
!

asOrderedDitheredGrayFormOn:aDevice
    "return a dithered depth-x grey form from the receiver image.
     Uses an 8x8 dithermatrix."

    |f depth bits|

    depth := aDevice depth.
    depth == 1 ifTrue:[
        "/ for monochrome, there is highly specialized
        "/ monochrome dither code available

        ^ self asOrderedDitheredMonochromeFormOn:aDevice
    ].

    bits := self
                orderedDitheredBitsWithDitherMatrix:(self class orderedDitherMatrixOfSize:8)
                ditherWidth:8
                depth:depth.

    ^ self makeDeviceGrayPixmapOn:aDevice depth:depth fromArray:bits

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asOrderedDitheredGrayFormOn:Display) inspect
    "

    "Modified: 10.6.1996 / 20:10:07 / cg"
!

asOrderedDitheredGrayImageDepth:depth
    "return a dithered depth-x grey image from the receiver image.
     Uses an 8x8 dithermatrix."

    |dither|

    dither := self class orderedDitherMatrixOfSize:8.

    depth == 1 ifTrue:[
        "/ for monochrome, there is highly specialized
        "/ monochrome dither code available

        ^ Depth1Image
            width:width
            height:height
            fromArray:(
                self
                    orderedDitheredMonochromeBitsWithDitherMatrix:dither
                    ditherWidth:8)
    ].

    ^ (self class implementorForDepth:depth)
        width:width
        height:height
        fromArray:(
            self
                orderedDitheredBitsWithDitherMatrix:dither
                ditherWidth:8
                depth:depth)

    "
     |i i1 i2 i4 i8|

     i := Image fromFile:'bitmaps/claus.gif'.
     i1 := i asOrderedDitheredGrayImageDepth:1.
     i1 inspect.

     i2 := i asOrderedDitheredGrayImageDepth:2.
     i2 inspect.

     i4 := i asOrderedDitheredGrayImageDepth:4.
     i4 inspect.

     i8 := i asOrderedDitheredGrayImageDepth:8.
     i8 inspect.
    "

    "
     |i i1 i2 i4 i8|
     i := Image fromFile:'bitmaps/garfield.gif'.
     i1 := i asOrderedDitheredGrayImageDepth:1.
     i1 inspect.

     i2 := i asOrderedDitheredGrayImageDepth:2.
     i2 inspect.

     i4 := i asOrderedDitheredGrayImageDepth:4.
     i4 inspect.

     i8 := i asOrderedDitheredGrayImageDepth:8.
     i8 inspect.

     i2 := i8 asOrderedDitheredGrayImageDepth:2.
     i2 inspect.
    "

    "Created: 7.6.1996 / 18:03:54 / cg"
    "Modified: 7.6.1996 / 19:41:59 / cg"
!

asOrderedDitheredMonochromeFormOn:aDevice
    "return a dithered monochrome form from the grey image.
     Uses a 4x4 dithermatrix."

    "/ 4x4 seems a good comprimize between:
    "/    number of grey levels (8x8 is better)
    "/    artifacts             (4x4 is better)
    "/
    "/ could look at the image and decide upon the number of
    "/ distinct colors present. Use 8x8 for high-number,
    "/ 4x4 for small number of colors ...

    ^ self 
        asOrderedDitheredMonochromeFormOn:aDevice 
        ditherMatrix:(self class orderedDitherMatrixOfSize:4)
        ditherWidth:4

"/    ^ self 
"/        asOrderedDitheredMonochromeFormOn:aDevice 
"/        ditherMatrix:(self class orderedDitherMatrixOfSize:8)
"/        ditherWidth:8

    "
     |i f|

     i := Image fromFile:'bitmaps/claus.gif'.
     f := i asOrderedDitheredMonochromeFormOn:Display.


     |i f|

     i := (Image fromFile:'/cdrom/icons/a/a11.ico') magnifiedBy:10.
     f := i asOrderedDitheredMonochromeFormOn:Display.


     |i f|

     i := Image fromFile:'bitmaps/garfield.gif'.
     f := i asOrderedDitheredMonochromeFormOn:Display.


     |i f|

     i := (Image fromFile:'bitmaps/PasteButton.tiff') magnifiedBy:10.
     f := i asOrderedDitheredMonochromeFormOn:Display.


     |i f|

     i := (Image fromFile:'bitmaps/blue-ball.gif') magnifiedBy:1.
     f := i asOrderedDitheredMonochromeFormOn:Display.
    "

    "Created: 7.6.1996 / 14:52:32 / cg"
    "Modified: 7.6.1996 / 16:37:47 / cg"
!

asOrderedDitheredMonochromeFormOn:aDevice ditherMatrix:ditherMatrix ditherWidth:dW
    "return a dithered monochrome form from the image.
     Uses the passed ditherMatrix and ditherWidth."

    |monoBits clr0 clr1|

    monoBits := self orderedDitheredMonochromeBitsWithDitherMatrix:ditherMatrix ditherWidth:dW.
    ^ self makeDeviceMonochromeBitmapOn:aDevice fromArray:monoBits


    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asOrderedDitheredMonochromeFormOn:Display) inspect


     |i|

     i := Image fromFile:'bitmaps/granite.tiff'.
     (i asOrderedDitheredMonochromeFormOn:Display) inspect


     |i|

     i := (Image fromFile:'bitmaps/PasteButton.tiff') magnifiedBy:10.
     (i asOrderedDitheredMonochromeFormOn:Display) inspect
    "

    "Created: 7.6.1996 / 14:51:42 / cg"
    "Modified: 10.6.1996 / 20:18:07 / cg"
!

asOrderedDitheredMonochromeImage
    "return a dithered monochrome image from the receiver image.
     Uses a 4x4 dithermatrix."

    "/ 4x4 seems a good comprimize between:
    "/    number of grey levels (8x8 is better)
    "/    artifacts             (4x4 is better)
    "/
    "/ could look at the image and decide upon the number of
    "/ distinct colors present. Use 8x8 for high-number,
    "/ 4x4 for small number of colors ...

    ^ self 
        asOrderedDitheredMonochromeImageWithDitherMatrix:(self class orderedDitherMatrixOfSize:4)
        ditherWidth:4

"/    ^ self 
"/        asOrderedDitheredMonochromeImageWithDitherMatrix:(self class orderedDitherMatrixOfSize:8)
"/        ditherWidth:8

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     i asOrderedDitheredMonochromeImage inspect


     |i|

     i := (Image fromFile:'/cdrom/icons/a/a11.ico') magnifiedBy:10.
     i asOrderedDitheredMonochromeImage inspect


     |i|

     i := Image fromFile:'bitmaps/garfield.gif'.
     i asOrderedDitheredMonochromeImage inspect


     |i|

     i := (Image fromFile:'bitmaps/PasteButton.tiff') magnifiedBy:10.
     i asOrderedDitheredMonochromeImage inspect


     |i|

     i := (Image fromFile:'bitmaps/blue-ball.gif') magnifiedBy:1.
     i asOrderedDitheredMonochromeImage inspect


     |i|

     i := Image fromFile:'bitmaps/granite.tiff'.
     i asOrderedDitheredMonochromeImage inspect
    "

    "Created: 7.6.1996 / 15:02:07 / cg"
    "Modified: 10.6.1996 / 11:15:09 / cg"
!

asOrderedDitheredMonochromeImageWithDitherMatrix:ditherMatrix ditherWidth:dW
    "return a dithered monochrome image from the receiver image.
     Uses the passed ditherMatrix and ditherWidth."

    |monoBits|

    monoBits := self orderedDitheredMonochromeBitsWithDitherMatrix:ditherMatrix ditherWidth:dW.
    ^ (Depth1Image width:width height:height fromArray:monoBits) photometric:#blackIs0

    "order-4 dither:

     |i|

     i := Image fromFile:'garfield.gif'.
     i
        asOrderedDitheredMonochromeImageWithDitherMatrix:(Image orderedDitherMatrixOfSize:4)
        ditherWidth:4
    "

    "order-6 dither:

     |i|

     i := Image fromFile:'garfield.gif'.
     i
        asOrderedDitheredMonochromeImageWithDitherMatrix:(Image orderedDitherMatrixOfSize:8)
        ditherWidth:8
    "


    "thresholding at:0.5 (all above 0.5 becomes white):

     |i|

     i := Image fromFile:'garfield.gif'.
     i
        asOrderedDitheredMonochromeImageWithDitherMatrix:(ByteArray new:16 withAll:8)
        ditherWidth:4
    "

    "thresholding at: 0.25 (all above 0.25 becomes white):

     |i|

     i := Image fromFile:'garfield.gif'.
     i
        asOrderedDitheredMonochromeImageWithDitherMatrix:(ByteArray new:16 withAll:3)
        ditherWidth:4
    "

    "thresholding at: 0.75 (all above 0.75 becomes white):

     |i|

     i := Image fromFile:'garfield.gif'.
     i
        asOrderedDitheredMonochromeImageWithDitherMatrix:(ByteArray new:16 withAll:11)
        ditherWidth:4
    "

    "Modified: 7.6.1996 / 17:23:47 / cg"
!

asPseudoFormQuickOn:aDevice
    "return a pseudo-deviceForm from the image.
     Fail if any color is not available (i.e. do not dither)."

    |f d dDev temp temp8 bits anyMissing clr cMap idMap 
     nClr "{ Class: SmallInteger }"
     usedColors |

    d := self depth.
    (d == 1
    or:[d == 2
    or:[d == 4
    or:[d == 8]]]) ifFalse:[^ nil].

    "/
    "/ see if all of the images colors are representable
    "/ on the device

    bits := self bitsPerPixel.
    nClr := (1 bitShift:bits).
    cMap := Array new:nClr.
    idMap := ByteArray new:nClr.

    photometric == #palette ifTrue:[
        nClr := nClr min:(colorMap size)
    ].

    d == 8 ifTrue:[
        usedColors := bytes usedValues.    "gets us an array filled with used values"
        1 to:nClr do:[:pixel |
            (usedColors includes:(pixel - 1)) ifFalse:[
                clr := Color black
            ] ifTrue:[
                clr := self colorFromValue:pixel-1.
                clr := clr exactOn:aDevice.
                clr isNil ifTrue:[^ nil].
            ].
            cMap at:(pixel) put:clr.
            idMap at:(pixel) put:(clr colorId).
        ].
    ] ifFalse:[
        1 to:nClr do:[:pixel |
            clr := self colorFromValue:pixel-1.
            clr := clr exactOn:aDevice.
            clr isNil ifTrue:[^ nil].

            cMap at:(pixel) put:clr.
            idMap at:(pixel) put:(clr colorId).
        ].
    ].

    "/ got all colors; good - simply change depth & translate pixels

    dDev := aDevice depth.

    (d == 8 and:[dDev == 8]) ifTrue:[
        "/ only translate
        temp := ByteArray uninitializedNew:(width * height).
        bytes expandPixels:8         "xlate only"
                    width:width 
                   height:height
                     into:temp
                  mapping:idMap.
    ] ifFalse:[

        "/ stupid: expandPixels can only handle any-to-8
        "/ compressPixels can only handle 8-to-any

        d ~~ 8 ifTrue:[
            temp8 := ByteArray uninitializedNew:(width * height).

            bytes expandPixels:d      
                         width:width 
                        height:height
                          into:temp8
                       mapping:idMap.
            idMap := nil.
        ] ifFalse:[
            temp8 := bytes.
        ].

        dDev ~~ 8 ifTrue:[
            temp := ByteArray uninitializedNew:((width * dDev + 7) // 8 * height).

            temp8 compressPixels:dDev      
                         width:width 
                        height:height
                          into:temp
                       mapping:idMap.
        ] ifFalse:[
            temp := temp8
        ].
    ].

    f := Form width:width height:height depth:dDev on:aDevice.
    f isNil ifTrue:[^ nil].

    f colorMap:cMap. 
    f initGC.

    aDevice 
        drawBits:temp 
        depth:dDev 
        width:width 
        height:height
        x:0 y:0
        into:(f id) x:0 y:0 
        width:width 
        height:height 
        with:(f gcId).

    ^ f

    "
     (
        (((Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ]))
               magnifiedBy:30
         )
          asPseudoFormQuickOn:Display
      ) inspect
     "

    "Modified: 17.6.1996 / 17:31:49 / cg"
!

asStevensonArceDitheredMonochromeImage
    "return a stevenson-arce dithered monochrome image from the receiver image.
     Depending on the images contents, this may or may not look better than
     a floyd-steinberg dithered image.
     Notice, that floyd-steinberg dithering is faster; both because less
     error diffusion is done and due to being specially tuned."

    |monoBits|

    monoBits := self stevensonArceDitheredMonochromeBits.
    ^ (Depth1Image width:width height:height fromArray:monoBits) photometric:#blackIs0

    "
     |i|

     i := Image fromFile:'garfield.gif'.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asStevensonArceDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Image fromFile:'claus.gif'.
     i inspect.
     i asFloydSteinbergDitheredMonochromeImage inspect.
     i asBurkesDitheredMonochromeImage inspect.
     i asStevensonArceDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "
     |i|

     i := Depth4Image
             width:4 
             height:4
             fromArray:#[ 
                            16r01 16r23
                            16r45 16r67
                            16r89 16rab
                            16rcd 16ref 
                        ].
     i := i magnifiedBy:30.
     i inspect.
     i asStevensonArceDitheredMonochromeImage inspect.
     i asOrderedDitheredMonochromeImage inspect.
    "

    "Created: 10.6.1996 / 12:38:29 / cg"
    "Modified: 12.6.1996 / 13:58:24 / cg"
!

asThresholdGrayFormOn:aDevice
    "return a thresholded grey form from the receiver image."

    |depth|

    (depth := aDevice depth) == 1 ifTrue:[
        ^ self asThresholdMonochromeFormOn:aDevice
    ].

    ^ self 
        makeDeviceGrayPixmapOn:aDevice 
        depth:depth 
        fromArray:(self
                        orderedDitheredBitsWithDitherMatrix:#[8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8]
                        ditherWidth:4
                        depth:depth)

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asThresholdGrayFormOn:Display) inspect.
    "

    "Created: 10.6.1996 / 18:38:31 / cg"
    "Modified: 10.6.1996 / 20:10:26 / cg"
!

asThresholdGrayImageDepth:depth
    "return a thresholded depth-x grey image from the receiver image."

    depth == 1 ifTrue:[
        "/ for monochrome, there is highly specialized
        "/ monochrome dither code available

        ^ Depth1Image
            width:width
            height:height
            fromArray:(
                self
                    orderedDitheredMonochromeBitsWithDitherMatrix:#[8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8]
                    ditherWidth:4)
    ].

    ^ (self class implementorForDepth:depth)
        width:width
        height:height
        fromArray:(
            self
                orderedDitheredBitsWithDitherMatrix:#[8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8]
                ditherWidth:4
                depth:depth)

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     (i asThresholdGrayImageDepth:1) inspect.
     (i asThresholdGrayImageDepth:2) inspect.
     (i asThresholdGrayImageDepth:4) inspect.
     (i asThresholdGrayImageDepth:8) inspect.

     (i asOrderedDitheredGrayImageDepth:1) inspect.
     (i asOrderedDitheredGrayImageDepth:2) inspect.
     (i asOrderedDitheredGrayImageDepth:4) inspect.
     (i asOrderedDitheredGrayImageDepth:8) inspect.

     (i asFloydSteinbergDitheredGrayImageDepth:1) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:2) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:4) inspect.
     (i asFloydSteinbergDitheredGrayImageDepth:8) inspect.
    "

    "Created: 7.6.1996 / 18:13:33 / cg"
    "Modified: 10.6.1996 / 14:20:56 / cg"
!

asThresholdMonochromeFormOn:aDevice
    "return a threshold monochrome form from the image."

    ^ self 
        asOrderedDitheredMonochromeFormOn:aDevice 
        ditherMatrix:#[8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8]
        ditherWidth:4

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     i inspect.
     (i asThresholdMonochromeFormOn:Display) inspect


     |i|

     i := (Image fromFile:'bitmaps/a11.ico') magnifiedBy:10.
     i inspect.
     (i asThresholdMonochromeFormOn:Display) inspect


     |i|

     i := Image fromFile:'bitmaps/granite.tiff'.
     i inspect.
     (i asThresholdMonochromeFormOn:Display) inspect


     |i|

     i := (Image fromFile:'bitmaps/PasteButton.tiff') magnifiedBy:10.
     i inspect.
     (i asThresholdMonochromeFormOn:Display) inspect
    "

    "Created: 7.6.1996 / 16:15:17 / cg"
    "Modified: 10.6.1996 / 17:44:29 / cg"
!

asThresholdMonochromeImage
    "return a threshold monochrome image from the image.
     Threshold means: brightness < 0.5 -> black / otherwise white"

    ^ self
        asOrderedDitheredMonochromeImageWithDitherMatrix:#[8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8]
        ditherWidth:4

    "
     |i i2|

     i := Image fromFile:'bitmaps/claus.gif'.
     i2 := i asThresholdMonochromeImage


     |i i2|

     i := (Image fromFile:'/cdrom/icons/a/a11.ico') magnifiedBy:10.
     i2 := i asThresholdMonochromeImage


     |i i2|

     i := Image fromFile:'bitmaps/granite.tiff'.
     i2 := i asThresholdMonochromeImage


     |i i2|

     i := (Image fromFile:'bitmaps/PasteButton.tiff') magnifiedBy:10.
     i2 := i asThresholdMonochromeImage
    "

    "Created: 7.6.1996 / 16:15:17 / cg"
    "Modified: 7.6.1996 / 17:16:10 / cg"
!

asThresholdMonochromeImage:thresholdBrighness
    "return a threshold monochrome image from the image.
     The argument (0..1) gives the threshold value;
     Threshold means: brightness < threshold -> black / otherwise white"

    |value ditherMatrix|

    value := thresholdBrighness * 255.
    ditherMatrix := ByteArray new:256 withAll:(value truncated).

    ^ self
        asOrderedDitheredMonochromeImageWithDitherMatrix:ditherMatrix
        ditherWidth:16

    "
     |i|

     i := Image width:4 height:4 depth:4
                fromArray:#[ 16r01 16r23
                             16r45 16r67
                             16r89 16rab
                             16rcd 16ref ].
     i := i magnifiedBy:30.
     i inspect.
     (i asThresholdMonochromeImage:0.125) inspect.
     (i asThresholdMonochromeImage:0.25) inspect.
     (i asThresholdMonochromeImage:0.5) inspect.
     (i asThresholdMonochromeImage:0.75) inspect.
     (i asThresholdMonochromeImage:1) inspect.
    "

    "
     |i|

     i := Image fromFile:'bitmaps/claus.gif'.
     i inspect.
     (i asThresholdMonochromeImage:0.125) inspect.
     (i asThresholdMonochromeImage:0.25) inspect.
     (i asThresholdMonochromeImage:0.5) inspect.
     (i asThresholdMonochromeImage:0.625) inspect.
     (i asThresholdMonochromeImage:0.75) inspect.
    "

    "Created: 7.6.1996 / 16:15:17 / cg"
    "Modified: 8.6.1996 / 14:51:57 / cg"
!

fromForm:aForm
    "setup the receiver from a form"

    |map c0 c1|

    width := aForm width.
    height := aForm height.
    bytes := aForm bits.
    bitsPerSample := self bitsPerSample.
    samplesPerPixel := self samplesPerPixel.
    map := aForm colorMap.

    aForm depth == 1 ifTrue:[
        map isNil ifTrue:[
            photometric := #whiteIs0
        ] ifFalse:[
            c0 := map at:1.
            c1 := map at:2.
            ((c0 = Color white)
            and:[c1 = Color black]) ifTrue:[
                photometric := #whiteIs0
            ] ifFalse:[
                ((c0 = Color black)
                and:[c1 = Color white]) ifTrue:[
                    photometric := #blackIs0
                ] ifFalse:[
                    photometric := #palette.
                    colorMap := Array with:c0 with:c1.
                ]
            ]
        ]
    ] ifFalse:[
        map notNil ifTrue:[
            photometric := #palette.
            colorMap := map copy.
        ] ifFalse:[
            "
             photometric stays at default
             (which is rgb for d24, greyscale for others)
            "
        ]
    ].

    "Modified: 8.6.1996 / 16:02:03 / cg"
!

fromImage:anImage
    "setup the receiver from another image.
     Color precision may be lost, if conversion is from a higher depth
     image. 
     WARNING:
     This implementation is a slow fallback (the loop over the
     source pixels is very slow). If this method is used heavily, you
     may want to redefine it in concrete subclasses for common source images."

    width := anImage width.
    height := anImage height.
    bytes := ByteArray uninitializedNew:(self bytesPerRow * height).
    bitsPerSample := self bitsPerSample.
    samplesPerPixel := self samplesPerPixel.
    self colormapFromImage:anImage.
    anImage colorsFromX:0 y:0 toX:(width-1) y:(height-1) do:[:x :y :clr |
        self atX:x y:y put:clr
    ].

    "
     |i i2 i4 i8 i16 i24|

     i := Image fromFile:'bitmaps/SBrowser.xbm'.
     i inspect.
     i2 := Depth2Image fromImage:i.
     i2 inspect.
     i4 := Depth4Image fromImage:i.
     i4 inspect.
     i8 := Depth8Image fromImage:i.
     i8 inspect.
     i24 := Depth24Image fromImage:i.
     i24 inspect.
    "

    "Created: 20.9.1995 / 00:59:03 / claus"
    "Modified: 7.6.1996 / 16:23:03 / cg"
!

fromSubImage:anImage in:aRectangle
    "setup the receiver from another image, extracting a rectangular
     area. Color precision may be lost, if conversion is from a higher depth
     image. For palette & rgb images, this may fail if a color cannot be
     represented.

     WARNING:
       This implementation is a slow fallback (the loop over the
       source pixels is very slow). If this method is used heavily, you
       may want to redefine it in concrete subclasses for the common case of
       of creating a subImage with the same depth & palette."

    |x0 y0|

    width := aRectangle width + 1.
    height := aRectangle height + 1.
    bytes := ByteArray uninitializedNew:(self bytesPerRow * height).
    bitsPerSample := self bitsPerSample.
    samplesPerPixel := self samplesPerPixel.
    self colormapFromImage:anImage.
    x0 := aRectangle left.
    y0 := aRectangle top.

    ((photometric == anImage photometric)
    and:[self bitsPerPixel = anImage bitsPerPixel
    and:[colorMap = anImage colorMap]]) ifTrue:[
        "/ can do it by value
        anImage valuesFromX:x0  y:y0 
                        toX:aRectangle right y:aRectangle bottom 
                         do:[:x :y :pixelValue |
            self atX:x-x0 y:y-y0 putValue:pixelValue.
        ]
    ] ifFalse:[
        "/ must do it by colors
        anImage colorsFromX:x0  y:y0 
                        toX:aRectangle right y:aRectangle bottom 
                         do:[:x :y :clr |
            self atX:x-x0 y:y-y0 put:clr.
        ]
    ].

    "
     |i i2 i4 i8 i16 i24|

     i := Image fromFile:'bitmaps/garfield.gif'.
     i inspect.
     i4 := Depth4Image fromSubImage:i in:(300@160 corner:340@200).
     i4 inspect.
     i8 := Depth8Image fromSubImage:i in:(300@160 corner:340@200).
     i8 inspect.
     i24 := Depth24Image fromSubImage:i in:(300@160 corner:340@200).
     i24 inspect.
    "

    "Created: 20.9.1995 / 01:06:02 / claus"
    "Modified: 20.9.1995 / 10:15:37 / claus"
    "Modified: 10.6.1996 / 18:30:17 / cg"
!

monochromeOn:aDevice
    "return a monochrome device image of the receiver for aDevice.
     (monochrome, even if device supports colors)"

    ((aDevice == device) and:[monoDeviceForm notNil]) ifTrue:[^ self].
    (device notNil and:[aDevice ~~ device]) ifTrue:[
	"oops, I am already accociated to another device
	 - need a copy ...
	"
	^ self copy monochromeOn:aDevice
    ].
    monoDeviceForm := self asMonochromeFormOn:aDevice.
!

on:aDevice
    "return an image with the same pixels as the receiver, but
     associated to aDevice. If the receiver is not yet bound to
     a device, this will be the receiver. Otherwise, a new image
     is returned."

    ((aDevice == device) and:[deviceForm notNil]) ifTrue:[^ self].

    (device notNil and:[aDevice ~~ device]) ifTrue:[
        "oops, I am already accociated to another device
         - need a copy ...
        "
        ^ self copy on:aDevice
    ].
    deviceForm := self asFormOn:aDevice.
    device := aDevice

    "Modified: 14.6.1996 / 15:28:30 / cg"
! !

!Image methodsFor:'converting greyscale images'!

greyImageAsFormOn:aDevice
    "return a thresholded grey-deviceForm from the grey image."

    |pictureDepth nPlanes f|


    nPlanes := samplesPerPixel.
    (nPlanes == 2) ifTrue:[
        'IMAGE: alpha plane ignored' errorPrintNL.
        nPlanes := 1
    ].

    pictureDepth := bitsPerSample at:1.

    "monochrome is very easy ..."

    (pictureDepth == 1) ifTrue:[
        ^ Form width:width height:height fromArray:bytes on:aDevice
    ].

    (aDevice visualType == #TrueColor) ifTrue:[
        ^ self greyImageAsTrueColorFormOn:aDevice
    ].

"/    (aDevice visualType == #PseudoColor 
"/    or:[aDevice visualType == #GrayScale
"/    or:[aDevice visualType == #StaticColor]]) ifTrue:[

    "/ PseudoColor conversion also works for StaticColor,
    "/ GrayScale and DirectColor; although possibly with suboptimal results

    ^ self greyImageAsPseudoFormOn:aDevice

    "Modified: 14.6.1996 / 19:32:01 / cg"
!

greyImageAsPseudoFormOn:aDevice
    "return an 8-bit pseudo Form from the grey image"

    |wideBits pictureDepth f map  
     colorMap usedColors nUsed aColor 
     nColors "{ Class: SmallInteger }"
     range id|

    pictureDepth := bitsPerSample at:1.

    (#(2 4 8) includes:pictureDepth) ifFalse:[
        self error:'currently only depth-2, 4 or 8 supported'.
        ^ nil
    ].

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

    (pictureDepth == 8) ifTrue:[
        "for 8bits, we scan for used colors first;
         to avoid allocating too many colors"

        usedColors := bytes usedValues.
        nUsed := usedColors max + 1.

        colorMap := Array new:nUsed.
        photometric == #blackIs0 ifTrue:[
            usedColors do:[:grey |
                colorMap at:(grey + 1) put:(Color gray:(100.0 / 256.0 * grey))
            ]
        ] ifFalse:[
            usedColors do:[:grey |
                colorMap at:(grey + 1) put:(Color gray:(100 - (100.0 / 256.0 * grey)))
            ]
        ]
    ] ifFalse:[
        nColors := (1 bitShift:pictureDepth).
        colorMap := Array new:nColors.
        range := 100 / (nColors - 1) asFloat.
        photometric == #blackIs0 ifTrue:[
            1 to:nColors do:[:i |
                colorMap at:i put:(Color gray:(i - 1) * range).
            ].
        ] ifFalse:[
            1 to:nColors do:[:i |
                colorMap at:(nColors - i + 1) put:(Color gray:(i - 1) * range).
            ].
        ].
    ].

    "XXX should reduce 8->6->4->2 planes, if not all colors could be allocated"

    "setup the translation map"
    map := ByteArray uninitializedNew:256.
    nColors := colorMap size.
    1 to:nColors do:[:i |
        aColor := colorMap at:i.
        aColor notNil ifTrue:[
            aColor := aColor on:aDevice.
            colorMap at:i put:aColor.
            id := aColor colorId.
            id notNil ifTrue:[
                map at:i put:id
            ] ifFalse:[
                map at:i put:0
            ]
        ]
    ].

    "expand & translate"
    bytes expandPixels:pictureDepth
                width:width 
               height:height
                 into:wideBits
              mapping:map.

    f := Form width:width height:height depth:8 on:aDevice.
    f isNil ifTrue:[^ nil].
    f colorMap:colorMap. 
    f initGC.
    aDevice drawBits:wideBits 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

    "Modified: 28.5.1996 / 20:55:57 / cg"
!

greyImageAsTrueColorFormOn:aDevice
    "return a true-color device-form for the grey-image receiver.
     TODO: the pixel loops ought to be implemented as inline primitive code ..."

    |depth  
     myDepth "{ Class: SmallInteger }"
     nColors "{ Class: SmallInteger }"
     colorValues
     scaleDown scaleRed scaleGreen scaleBlue redShift blueShift greenShift
     form imageBitsdestIndex 
     bestFormat usedDeviceDepth usedDeviceBitsPerPixel imageBits destIndex
     nPixels|

    "/ this is a slow fallback method; this ought to be
    "/ redefined in DepthxImage for more performance.

    depth := aDevice depth.
    myDepth := self depth.
    myDepth > 12 ifTrue:[
        self error:'unsupported trueColor depth in greyImageAsTrueColorFormOn:'.
        ^ nil
    ].

    "/ compute scale to map from my pixels into devices range

    scaleDown := 1 bitShift:myDepth.
    scaleRed := (1 bitShift:aDevice bitsRed).
    scaleGreen := (1 bitShift:aDevice bitsGreen).
    scaleBlue := (1 bitShift:aDevice bitsBlue).
    redShift := aDevice shiftRed.
    greenShift := aDevice shiftGreen.
    blueShift := aDevice shiftBlue.

    nColors := (1 bitShift:myDepth).
    colorValues := Array new:nColors.
    1 to:nColors do:[:i |
        |v gv bv rv nv|

        "/ scale down to 0..1
        v := (i-1) / scaleDown.
        rv := (v * scaleRed) rounded.
        gv := (v * scaleGreen) rounded.
        bv := (v * scaleBlue) rounded.
        nv := rv bitShift:redShift.
        nv := nv bitOr:(gv bitShift:greenShift).
        nv := nv bitOr:(bv bitShift:blueShift).
        colorValues at:i put:nv
    ].
    photometric == #whiteIs0 ifTrue:[
        "/ reverse the order; 0 is brightest
        colorValues reverse
    ].

    bestFormat := self bestSupportedImageFormatFor:aDevice.
    usedDeviceDepth := bestFormat at:#depth.
    usedDeviceBitsPerPixel := bestFormat at:#bitsPerPixel.

    "/ for now, only support some depths

    usedDeviceBitsPerPixel == 16 ifTrue:[
        imageBits := ByteArray uninitializedNew:(width * height * 2).

        "/ now, walk over the image and replace
        "/ colorMap indices by color values in the bits array

        destIndex := 1.
        0 to:height-1 do:[:y |
            0 to:width-1 do:[:x |
                |greyValue|

                greyValue := self valueAtX:x y:y.
                imageBits wordAt:destIndex put:(colorValues at:greyValue + 1) MSB:true.
                destIndex := destIndex + 2.
            ]
        ]
    ] ifFalse:[
        usedDeviceBitsPerPixel == 32 ifTrue:[
            imageBits := ByteArray uninitializedNew:(width * height * 4).

            "/ now, walk over the image and replace
            "/ colorMap indices by color values in the bits array

            destIndex := 1.
            0 to:height-1 do:[:y |
                0 to:width-1 do:[:x |
                    |greyValue|

                    greyValue := self valueAtX:x y:y.
                    imageBits doubleWordAt:destIndex put:(colorValues at:greyValue + 1) MSB:true.
                    destIndex := destIndex + 4.
                ]
            ]
        ]
    ].

    imageBits isNil ifTrue:[            
        'IMAGE: unimplemented trueColor depth on greyImageAsTrueColorFormOn:' errorPrintNL.
        ^ self asMonochromeFormOn:aDevice
    ].

    form :=
    form := Form width:width height:height depth:usedDeviceDepth on:aDevice.
    form isNil ifTrue:[^ nil].
    form initGC.

    form 
        copyBitsFrom:imageBits bitsPerPixel:usedDeviceBitsPerPixel depth:usedDeviceDepth 
               width:width height:height 
                   x:0 y:0 toX:0 y:0. 

    ^ form

    "Created: 20.10.1995 / 22:05:10 / cg"
    "Modified: 10.6.1996 / 19:15:13 / cg"
! !

!Image methodsFor:'converting palette images'!

paletteImageAsFormOn:aDevice
    "return a device-form for the palette-image receiver"

    |type ddepth|

    ddepth := aDevice depth.

    ((type := aDevice visualType) == #StaticGray) ifTrue:[
        ddepth == 8 ifTrue:[
            ^ self paletteImageAsGray8FormOn:aDevice
        ].
        ^ self asGrayFormOn:aDevice
    ].

    (type == #TrueColor) ifTrue:[
        DitherAlgorithm == #floydSteinberg ifTrue:[
            ddepth == 8 ifTrue:[
                self depth == 8 ifTrue:[
                    "/ use fixColor dither algorithm
                    ^ self asDitheredTrueColor8FormOn:aDevice
                ]
            ]
        ].

        ^ self paletteImageAsTrueColorFormOn:aDevice
    ].

    "/ the PseudoColor conversion also works for
    "/ StaticColor, GrayScale & DirectColor; although possibly with suboptimal results

    ^ self paletteImageAsPseudoFormOn:aDevice

    "Modified: 14.6.1996 / 19:31:01 / cg"
!

paletteImageAsPseudoFormOn:aDevice
    "return a pseudo-deviceForm from the palette image."

    |tempImage d temp8|

    d := self depth.
    (#(1 2 4 8) includes:d) ifTrue:[ 
	"
	 fallback code for some depth's:
	 create a temporary Depth8Image and use its conversion method
	"
	temp8 := ByteArray uninitializedNew:(width * height).

	bytes expandPixels:d      
		     width:width 
		   height:height
		     into:temp8
		  mapping:nil.

	tempImage := Image width:width height:height depth:8 fromArray:temp8.
	tempImage colorMap:colorMap.
	^ tempImage paletteImageAsPseudoFormOn:aDevice
    ].
    ^ self subclassResponsibility
!

paletteImageAsTrueColorFormOn:aDevice
    "return a true-color device-form for the palette-image receiver."

    |depth 
     myDepth "{ Class: SmallInteger }"
     nColors "{ Class: SmallInteger }"
     colorValues 
     scaleRed scaleGreen scaleBlue redShift greenShift blueShift
     form imageBits bestFormat usedDeviceDepth usedDeviceBitsPerPixel 
     destIndex|

    "/ this is a slow fallback method; this ought to be
    "/ redefined in DepthxImage for more performance.

    depth := aDevice depth.
    myDepth := self bitsPerPixel.
    myDepth > 12 ifTrue:[
        'IMAGE: depth > 12 not supported' errorPrintNL.
        ^ nil
    ].

    "/ gather r/g/b values for all colors in the map ...

    nColors := colorMap size.

    "/ precompute scales to map from 0..100 into devices range
    "/ (this may be different for the individual components)

    scaleRed := ((1 bitShift:aDevice bitsRed) - 1) / 100.
    scaleGreen := ((1 bitShift:aDevice bitsGreen) - 1) / 100.
    scaleBlue := ((1 bitShift:aDevice bitsBlue) - 1) / 100.
    redShift := aDevice shiftRed.
    greenShift := aDevice shiftGreen.
    blueShift := aDevice shiftBlue.

    colorValues := Array uninitializedNew:nColors.

    1 to:nColors do:[:index |
        |clr rv gv bv v "{ Class: SmallInteger }" |

        clr := colorMap at:index.
        clr notNil ifTrue:[
            rv := (clr red * scaleRed) rounded.
            gv := (clr green * scaleGreen) rounded.
            bv := (clr blue * scaleBlue) rounded.

            v := rv bitShift:redShift.
            v := v bitOr:(gv bitShift:greenShift).
            v := v bitOr:(bv bitShift:blueShift).
            colorValues at:index put:v.
"/ clr print. ' ' print.
"/ rv print. ' ' print. gv print. ' ' print. bv print. ' ' print.
"/ ' -> ' print. v printNL.

        ]
    ].

    bestFormat := self bestSupportedImageFormatFor:aDevice.
    usedDeviceDepth := bestFormat at:#depth.
    usedDeviceBitsPerPixel := bestFormat at:#bitsPerPixel.

    "/ for now, only support some depths

    "/ 16 bits/pixel

    usedDeviceBitsPerPixel == 16 ifTrue:[
        imageBits := ByteArray uninitializedNew:(width * height * 2).

        "/ now, walk over the image and replace
        "/ colorMap indices by color values in the bits array

%{  
        if (__bothSmallInteger(_INST(height), _INST(width))
         && __isArray(colorValues)
         && __isByteArray(_INST(bytes))
         && (myDepth == __MKSMALLINT(8))
         && __isByteArray(imageBits)) {
            int x, y, w, h, nPix;

            unsigned char *srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
            char *dstPtr = _ByteArrayInstPtr(imageBits)->ba_element;
            OBJ *ap = __ArrayInstPtr(colorValues)->a_element;

            w = __intVal(_INST(width));
            h = __intVal(_INST(height));
            nPix = w * h;
            while (nPix > 0) {
                unsigned idx, v;
                OBJ clr;

                idx = *srcPtr;
                clr = ap[idx];
                v = __intVal(clr);
#ifdef MSBFIRST
                ((short *)dstPtr)[0] = v;
#else
                dstPtr[0] = (v>>8) & 0xFF;
                dstPtr[1] = (v) & 0xFF;
#endif
                dstPtr += 2;
                srcPtr += 1;
                nPix--;
            }
        }
%}.
    ] ifFalse:[
        "/ 32 bits/pixel

        usedDeviceBitsPerPixel == 32 ifTrue:[
            imageBits := ByteArray uninitializedNew:(width * height * 4).

            "/ now, walk over the image and replace
            "/ colorMap indices by color values in the bits array

%{       
            if (__bothSmallInteger(_INST(height), _INST(width))
             && __isArray(colorValues)
             && __isByteArray(_INST(bytes))
             && (myDepth == __MKSMALLINT(8))
             && __isByteArray(imageBits)) {
                int x, y, w, h, nPix;

                unsigned char *srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
                char *dstPtr = _ByteArrayInstPtr(imageBits)->ba_element;
                OBJ *ap = __ArrayInstPtr(colorValues)->a_element;

                w = __intVal(_INST(width));
                h = __intVal(_INST(height));
                nPix = w * h;
                while (nPix > 0) {
                    unsigned idx, v;
                    OBJ clr;

                    idx = *srcPtr;
                    clr = ap[idx];
                    v = __intVal(clr);
#ifdef MSBFIRST
                    ((long *)dstPtr)[0] = v;
#else
                    dstPtr[0] = (v>>24) & 0xFF;
                    dstPtr[1] = (v>>16) & 0xFF;
                    dstPtr[2] = (v>>8) & 0xFF;
                    dstPtr[3] = (v) & 0xFF;
#endif
                    dstPtr += 4;
                    srcPtr += 1;
                    nPix--;
                }
            }
%}.
        ] ifFalse:[
            "/ 8 bits/pixel

            usedDeviceBitsPerPixel == 8 ifTrue:[
                imageBits := ByteArray uninitializedNew:(width * height).

                "/ now, walk over the image and replace
                "/ colorMap indices by color values in the bits array

%{       
                if (__bothSmallInteger(_INST(height), _INST(width))
                 && __isArray(colorValues)
                 && __isByteArray(_INST(bytes))
                 && (myDepth == __MKSMALLINT(8))
                 && __isByteArray(imageBits)) {
                    int x, y, w, h, nPix;

                    unsigned char *srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
                    char *dstPtr = _ByteArrayInstPtr(imageBits)->ba_element;
                    OBJ *ap = __ArrayInstPtr(colorValues)->a_element;

                    w = __intVal(_INST(width));
                    h = __intVal(_INST(height));
                    nPix = w * h;
                    while (nPix > 0) {
                        unsigned idx, v;
                        OBJ clr;

                        idx = *srcPtr;
                        clr = ap[idx];
                        v = __intVal(clr);

                        dstPtr[0] = v;

                        dstPtr += 1;
                        srcPtr += 1;
                        nPix--;
                    }
                }
%}.
            ]
        ]
    ].

    imageBits isNil ifTrue:[            
        'IMAGE: unimplemented trueColor depth in paletteImageAsTrueColorFormOn: ' errorPrint. usedDeviceBitsPerPixel errorPrintNL.
        ^ self asMonochromeFormOn:aDevice
    ].

    form := Form width:width height:height depth:usedDeviceDepth on:aDevice.
    form isNil ifTrue:[^ nil].
    form initGC.

    form 
        copyBitsFrom:imageBits bitsPerPixel:usedDeviceBitsPerPixel depth:usedDeviceDepth 
               width:width height:height 
                   x:0 y:0 toX:0 y:0. 

    ^ form

    "Created: 20.10.1995 / 22:05:10 / cg"
    "Modified: 21.10.1995 / 19:30:26 / cg"
! !

!Image methodsFor:'converting rgb images'!

asDitheredTrueColor8FormOn:aDevice
    "convert an rgb image to a dithered depth8-form on aDevice.
     Return the device-form."

    |fixColors pixel
     dstIdx     "{ Class: SmallInteger }"
     shiftRed   "{ Class: SmallInteger }"
     shiftGreen "{ Class: SmallInteger }"
     shiftBlue  "{ Class: SmallInteger }"
     nRed    "{ Class: SmallInteger }"
     nGreen  "{ Class: SmallInteger }"
     nBlue   "{ Class: SmallInteger }"|

    shiftRed := aDevice shiftRed.
    shiftGreen := aDevice shiftGreen.
    shiftBlue := aDevice shiftBlue.

    nRed := (1 bitShift:aDevice bitsRed).
    nGreen := (1 bitShift:aDevice bitsGreen).
    nBlue := (1 bitShift:aDevice bitsBlue).

    fixColors := Array new:(nRed * nGreen * nBlue).

    dstIdx := 1.
    0 to:nRed - 1 do:[:sR |
        0 to:nGreen - 1 do:[:sG |
            0 to:nBlue - 1 do:[:sB |
                pixel := (sR bitShift:shiftRed)
                         + (sG bitShift:shiftGreen)
                         + (sB bitShift:shiftBlue).
                fixColors at:dstIdx put:(Color colorId:(pixel)).
                dstIdx := dstIdx + 1
            ]
        ]
    ].

    ^ self
        asFloydSteinbergDitheredDepth8FormOn:aDevice 
        colors:fixColors 
        nRed:nRed nGreen:nGreen nBlue:nBlue

    "Modified: 14.6.1996 / 17:18:57 / cg"
    "Created: 14.6.1996 / 17:23:52 / cg"
!

rgbImageAsFormOn:aDevice
    "convert am rgb image to a device-form on aDevice.
     Return the device-form."

    |visual|

    visual := aDevice visualType.
    (visual == #StaticGray) ifTrue:[
        ^ self asGrayFormOn:aDevice
    ].
    (visual == #TrueColor) ifTrue:[
        ^ self rgbImageAsTrueColorFormOn:aDevice
    ].

    "/ PseudoColor conversion also works for StaticColor, GrayScale
    "/ and DirectColor displays; although possibly with suboptimal results

    ^ self rgbImageAsPseudoFormOn:aDevice

    "Modified: 14.6.1996 / 19:30:06 / cg"
!

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

    |n     "{ Class: SmallInteger }"
     depth "{ Class: SmallInteger }"
     palette f|

    (depth := self depth) <= 8 ifTrue:[
        "/ simulate it via a temporary palette image

        palette := Array new:(1 bitShift:depth).

        n := (1 bitShift:depth)-1.
        0 to:n do:[:pixelValue |
            palette at:(pixelValue+1) put:(self colorFromValue:pixelValue)
        ].

        colorMap := palette.
        photometric := #palette.
        f := self paletteImageAsPseudoFormOn:aDevice.
        colorMap := nil.
        photometric := #rgb.
        ^ f
    ].

    ^ self subclassResponsibility

    "Modified: 8.6.1996 / 10:58:25 / cg"
!

rgbImageAsTrueColorFormOn:aDevice
    "return a truecolor form from the rgb-picture."

    |bestFormat usedDeviceDepth usedDeviceBitsPerPixel depth
     form|

    bestFormat := self bestSupportedImageFormatFor:aDevice.
    usedDeviceDepth := bestFormat at:#depth.
    usedDeviceBitsPerPixel := bestFormat at:#bitsPerPixel.

    "/ kludge for some 15bit XFree servers (should return 16 here - does not)
    usedDeviceBitsPerPixel == 15 ifTrue:[
        usedDeviceBitsPerPixel := 16
    ].

    "/
    "/ only the trivial case, where the depths match
    "/ is handled here; conversions are supposed to
    "/ be done in concrete subclasses (see D24Image)
    "/
    self bitsPerPixel == usedDeviceBitsPerPixel ifFalse:[
        'IMAGE: unimplemented trueColor depth in rgbImageAsTrueColorFormOn: ' errorPrint. self bitsPerPixel errorPrintNL.
        ^ self asMonochromeFormOn:aDevice
    ].

    form := Form width:width height:height depth:usedDeviceDepth on:aDevice.
    form isNil ifTrue:[
        'IMAGE: display bitmap creation failed' errorPrintNL.
        ^ nil
    ].
    form initGC.

    form 
        copyBitsFrom:bytes bitsPerPixel:usedDeviceBitsPerPixel depth:usedDeviceDepth 
               width:width height:height 
                   x:0 y:0 toX:0 y:0. 

    ^ form

    "Modified: 14.6.1996 / 16:57:47 / cg"
! !

!Image methodsFor:'copying'!

postCopy
    "redefined to also copy the pixels and the colorMap
     and clear out any device handles in the copy."

    bytes := bytes copy.
    colorMap := colorMap deepCopy.
    device := deviceForm := monoDeviceForm := fullColorDeviceForm := nil

    "Modified: 23.4.1996 / 11:12:03 / cg"
! !

!Image methodsFor:'displaying'!

displayFilledOn:aGC
    "display the receiver as an opaque image.
     This allows Images to be wrapped by a FillingWrapper"

    aGC displayOpaqueForm:self x:0 y:0.

    "Created: 29.5.1996 / 10:34:18 / cg"
    "Modified: 29.5.1996 / 10:52:36 / cg"
!

displayOn:aGC at:aPoint
    "draw the receiver in the graphicsContext, aGC.
     Smalltalk-80 compatibility"

    self displayOn:aGC x:aPoint x y:aPoint y.

    "Modified: 12.5.1996 / 20:16:38 / cg"
!

displayOn:aGC x:x y:y
    "draw the receiver in the graphicsContext, aGC.
     Smalltalk-80 compatibility"

    aGC displayForm:self x:x y:y.

    "Modified: 23.4.1996 / 11:12:31 / cg"
    "Created: 12.5.1996 / 20:14:31 / cg"
!

displayStrokedOn:aGC
    "display the receiver as an non opaque image.
     This allows Images to be wrapped by a StrokingWrapper"

    aGC displayForm:self x:0 y:0.

    "Created: 29.5.1996 / 10:34:18 / cg"
    "Modified: 29.5.1996 / 10:52:30 / cg"
! !

!Image methodsFor:'dither helpers'!

burkesDitheredMonochromeBits
    "return the bitmap for a dithered monochrome bitmap from the image.
     Works for any source depths / photometric"

    |dstIndex        "{Class: SmallInteger }"
     nextDst         "{Class: SmallInteger }"
     bytesPerMonoRow "{Class: SmallInteger }"
     monoBits greyValues
     errorArray
     errorArray1
     e t
     w               "{Class: SmallInteger }"
     h               "{Class: SmallInteger }"
     bitCnt          "{Class: SmallInteger }"
     byte            "{Class: SmallInteger }" 
     grey dT 
     eR eRB eB eLB |

    self depth > 12 ifTrue:[
        ^ self floydSteinbergDitheredMonochromeBits
    ].

    w := width.
    h := height.

    bytesPerMonoRow := (w + 7) // 8.
    monoBits := ByteArray uninitializedNew:(bytesPerMonoRow * h).
    (monoBits isNil or:[bytes isNil]) ifTrue:[
        ^ nil
    ].

    errorArray := Array new:(w+4).
    errorArray1 := Array new:(w+4) withAll:0.

    dstIndex := 1.

    "/ fetch scaled brightness values outside of loop into a table;
    "/ use table-value in loop

    greyValues := self greyMapForRange:(255*1024).
    
    0 to:(h-1) do:[:y |
        nextDst := dstIndex + bytesPerMonoRow.
        byte := 0.
        bitCnt := 8.

        t := errorArray.
        errorArray := errorArray1.
        errorArray1 := t.

        errorArray1 atAllPut:0.

        self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
            |eP "{Class: SmallInteger }" 
             eD 
             eI "{Class: SmallInteger }" 
             xE "{Class: SmallInteger }"
             xN "{Class: SmallInteger }" |

            "/ get the colors grey value [0 .. 1]
            grey := greyValues at:(pixel + 1).

            "/ adjust error
            xE := x + 2 + 1.
            grey := (grey + (errorArray at:xE)).

            byte := byte bitShift:1.
            grey > (127*1024) ifTrue:[
                byte := byte bitOr:1.      "/ white
                e := grey - (255*1024)
            ] ifFalse:[
                e := grey                  "/ black
            ].

            e ~= 0 ifTrue:[
                "/ distribute the error:
                "/                  XX  8  4
                "/             2  4  8  4  2

                eD := e.
                eI := e // 32.

                eP := eI * 8. eD := eD - eP.

                xN := xE + 1.
                errorArray at:xN put:(errorArray at:xN) + eP.

                eD := eD - eP.
                errorArray1 at:xE put:(errorArray1 at:xE) + eP.

                eP := eI * 4. eD := eD - eP.
                xN := xE + 2.
                errorArray at:xN put:(errorArray at:xN) + eP.

                eD := eD - eP.
                xN := xE - 1.
                errorArray1 at:xN put:(errorArray1 at:xN) + eP.

                eD := eD - eP.
                xN := xE + 1.
                errorArray1 at:xN put:(errorArray1 at:xN) + eP.

                eP := eI * 2. eD := eD - eP.
                xN := xE - 2.
                errorArray1 at:xN put:(errorArray1 at:xN) + eP.

                eD := eD.
                xN := xE + 2.
                errorArray1 at:xN put:(errorArray1 at:xN) + eP.
            ].

            bitCnt := bitCnt - 1.
            bitCnt == 0 ifTrue:[
                monoBits at:dstIndex put:byte.
                dstIndex := dstIndex + 1.
                byte := 0.
                bitCnt := 8.
            ].

        ].
        bitCnt ~~ 8 ifTrue:[
            byte := byte bitShift:bitCnt.
            monoBits at:dstIndex put:byte.
        ].

        dstIndex := nextDst.
    ].

    ^ monoBits

    "Created: 10.6.1996 / 12:18:20 / cg"
    "Modified: 10.6.1996 / 13:16:33 / cg"
!

floydSteinbergDitheredBitsDepth:depth
    "return the bitmap for a dithered depth bitmap from the image.
     Works for any source depths / photometric, 
     but very slow since each pixel is processed individually.
     Redefined by some subclasses for more performance (D8Image)"

    |dstIndex        "{Class: SmallInteger }"
     nextDst         "{Class: SmallInteger }"
     bytesPerOutRow  "{Class: SmallInteger }"
     outBits greyValues greyErrors greyPixels greyLevels
     errorArray
     nextErrorArray
     e t
     w               "{Class: SmallInteger }"
     h               "{Class: SmallInteger }"
     bitCnt          "{Class: SmallInteger }"
     byte            "{Class: SmallInteger }" 
     grey dT 
     eR eRB eB eLB |

    depth > 8 ifTrue:[
        self error:'unimplemented conversion'.
        ^ nil
    ].

    w := width.
    h := height.

    bytesPerOutRow := ((w * depth) + 7) // 8.
    outBits := ByteArray uninitializedNew:(bytesPerOutRow * h).
    (outBits isNil or:[bytes isNil]) ifTrue:[
        ^ nil
    ].

    greyLevels := (1 bitShift:depth) - 1.

    errorArray := Array new:w+2.
    nextErrorArray := Array new:w+2.

    nextErrorArray atAllPut:0.

    dstIndex := 1.
    bitCnt := 8.

    self depth <= 12 ifTrue:[
        "/ fetch scaled brightness values outside of loop into a table;
        "/ use table-value in loop

        greyValues := self greyMapForRange:(greyLevels).

        greyPixels := greyValues collect:[:v | v isNil ifTrue:[
                                                   0
                                               ] ifFalse:[
                                                   v truncated]].

        greyPixels := ByteArray withAll:greyPixels.

        greyErrors := greyValues collect:[:v | v isNil ifTrue:[
                                                   0
                                               ] ifFalse:[
                                                   ((v - v truncated) * 1024) truncated
                                               ]].

        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerOutRow.
            byte := 0.

            t := errorArray.
            errorArray := nextErrorArray.
            nextErrorArray := t.

            nextErrorArray atAllPut:0.

            self valuesAtY:y from:0 to:(w-1) do:[:x :value |
                |e     "{ Class: SmallInteger }"
                 pixel "{ Class: SmallInteger }"
                 error "{ Class: SmallInteger }"
                 e16   "{ Class: SmallInteger }"
                 xE    "{ Class: SmallInteger }" 
                 xN    "{ Class: SmallInteger }" |

                pixel := greyPixels at:(value + 1).

                "/ adjust error
                xE := x + 2.
                error := (greyErrors at:(value + 1)) + (errorArray at:xE).

                byte := byte bitShift:depth.
                error > 512 "0.5" ifTrue:[
                    pixel := pixel + 1.      
                    e := error - 1024 "1.0"
                ] ifFalse:[
                    e := error              
                ].
                byte := byte bitOr:pixel.

                e ~= 0 ifTrue:[
                    e16 := e // 16.

                    eR  := e16 * 7.              "/ 7/16 to right
                    eRB := e16 * 1.              "/ 1/16 to right below
                    eB  := e16 * 5.              "/ 5/16 to below
                    eLB := e - eR - eRB - eB.  "/ 3/16 to left below

                    xN := xE + 1.
                    eR ~= 0 ifTrue:[
                        errorArray     at:xN put:(errorArray at:xN) + eR.
                    ].
                    eRB ~= 0 ifTrue:[
                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB.
                    ].
                    eB ~= 0 ifTrue:[
                        nextErrorArray at:xE put:(nextErrorArray at:xE) + eB.
                    ].
                    eLB ~= 0 ifTrue:[
                        xN := xE - 1.
                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB.
                    ].
                ].

                bitCnt := bitCnt - depth.
                bitCnt == 0 ifTrue:[
                    outBits at:dstIndex put:byte.
                    dstIndex := dstIndex + 1.
                    byte := 0.
                    bitCnt := 8.
                ].

            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                outBits at:dstIndex put:byte.
                bitCnt := 8.
            ].

            dstIndex := nextDst.
        ].
    ] ifFalse:[
        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerOutRow.
            byte := 0.

            t := errorArray.
            errorArray := nextErrorArray.
            nextErrorArray := t.

            nextErrorArray atAllPut:0.

            self colorsAtY:y from:0 to:(w-1) do:[:x :clr |
                |e     "{ Class: SmallInteger }"
                 pixel "{ Class: SmallInteger }"
                 error "{ Class: SmallInteger }"
                 e16   "{ Class: SmallInteger }"
                 xE    "{ Class: SmallInteger }" 
                 xN    "{ Class: SmallInteger }" |

                grey := (clr brightness * greyLevels).
                pixel := grey truncated.
                error := ((grey - pixel) * 1024) truncated.

                "/ adjust error
                xE := x + 2.
                error := error + (errorArray at:xE).

                byte := byte bitShift:depth.
                error > 512 "0.5" ifTrue:[
                    pixel := pixel + 1.      
                    e := error - 1024 "1.0"
                ] ifFalse:[
                    e := error              
                ].

                byte := byte bitOr:pixel.

                e ~= 0 ifTrue:[
                    e16 := e // 16.

                    eR  := e16 * 7.              "/ 7/16 to right
                    eRB := e16 * 1.              "/ 1/16 to right below
                    eB  := e16 * 5.              "/ 5/16 to below
                    eLB := e - eR - eRB - eB.  "/ 3/16 to left below

                    xN := xE + 1.
                    eR ~= 0 ifTrue:[
                        errorArray     at:xN put:(errorArray at:xN) + eR.
                    ].
                    eRB ~= 0 ifTrue:[
                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB.
                    ].
                    eB ~= 0 ifTrue:[
                        nextErrorArray at:xE put:(nextErrorArray at:xE) + eB.
                    ].
                    eLB ~= 0 ifTrue:[
                        xN := xE - 1.
                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB.
                    ].
                ].

                bitCnt := bitCnt - depth.
                bitCnt == 0 ifTrue:[
                    outBits at:dstIndex put:byte.
                    dstIndex := dstIndex + 1.
                    byte := 0.
                    bitCnt := 8.
                ].

            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                outBits at:dstIndex put:byte.
                bitCnt := 8.
            ].

            dstIndex := nextDst.
        ].
    ].

    ^ outBits

    "Created: 10.6.1996 / 13:28:22 / cg"
    "Modified: 11.6.1996 / 00:13:38 / cg"
!

floydSteinbergDitheredDepth8BitsColors:colors
    "return a floyd-steinberg dithered bitmap from the receiver picture,
     which must be a depth-8 image. 
     This method expects an array of colors to be used for dithering
     (which need not be a colorCubes colors)."

    |pseudoBits  
     rgbBytes ditherRGBBytes ditherColors
     w       "{Class: SmallInteger }"
     h       "{Class: SmallInteger }"
     index   "{Class: SmallInteger }"
     fixR    "{Class: SmallInteger }"
     fixG    "{Class: SmallInteger }"
     fixB    "{Class: SmallInteger }"
     ditherIds failed map lastColor
     error clr|

    self depth ~~ 8 ifTrue:[^ nil].

    "/
    "/ collect color components as integer values (for integer arithmetic)
    "/
    rgbBytes := ByteArray uninitializedNew:256 * 3.

    photometric == #palette ifTrue:[
        lastColor := colorMap size - 1
    ] ifFalse:[
        lastColor := 255.
    ].
    index := 1.
    0 to:lastColor do:[:pix |
        clr := self colorFromValue:pix.
        rgbBytes at:index put:(clr redByte).
        rgbBytes at:index+1 put:(clr greenByte).
        rgbBytes at:index+2 put:(clr blueByte).

        index := index + 3.
    ].

    "/
    "/ collect ditherColor components

    ditherColors := colors select:[:clr | clr notNil].
    ditherIds := (ditherColors asArray collect:[:clr | clr colorId]) asByteArray.

    "/ collect ditherColor components

    lastColor := ditherColors size.
    ditherIds := ByteArray uninitializedNew:lastColor.
    ditherRGBBytes := ByteArray uninitializedNew:(lastColor * 3).
    index := 1.
    1 to:lastColor do:[:pix |
        clr := ditherColors at:pix.
        ditherRGBBytes at:index put:(clr redByte).
        ditherRGBBytes at:index+1 put:(clr greenByte).
        ditherRGBBytes at:index+2 put:(clr blueByte).
        ditherIds at:pix put:clr colorId.

        index := index + 3.
    ].

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

    w := width + 2.
    error := ByteArray uninitializedNew:w*(3*2).

    w := width.
    h := height.

    failed := true.

%{
    int __x, __y;
    int __eR, __eG, __eB;
    unsigned char *srcP, *dstP;
    unsigned char *rgbP;
    unsigned char *idP;
    unsigned char *dp;
    short *errP, *eP;
    int __fR, __fG, __fB;
    int iR, iG, iB;
    int idx;
    int __w = __intVal(w);
    int __nColors = __intVal(lastColor);

    if (__isByteArray(__INST(bytes))
     && __isByteArray(pseudoBits)
     && __isByteArray(rgbBytes)
     && __isByteArray(ditherRGBBytes)
     && __isByteArray(ditherIds)
     && __isByteArray(error)) {
        failed = false;

        srcP = __ByteArrayInstPtr(_INST(bytes))->ba_element;
        dstP = __ByteArrayInstPtr(pseudoBits)->ba_element;
        rgbP = __ByteArrayInstPtr(rgbBytes)->ba_element;
        idP = __ByteArrayInstPtr(ditherIds)->ba_element;
        errP = (short *) _ByteArrayInstPtr(error)->ba_element;

        /*
         * clear error accumulator
         */
        eP = errP;
        bzero(eP, (__w+2) * 2 * 3);

        for (__y=__intVal(h); __y>0; __y--) {
            __eR = __eG = __eB = 0;

            eP = &(errP[3]);
            __eR = eP[0];
            __eG = eP[1];
            __eB = eP[2];

            for (__x=__w; __x>0; __x--) {
                int __want;
                int pix;
                int __wantR, __wantG, __wantB;
                int __wR, __wG, __wB;
                int idx;
                int tR, tG, tB;
                int nR, nG, nB;
                int dR, dG, dB;
                int minDelta, bestIdx;

                pix = *srcP++;

                /*
                 * wR, wG and wB is the wanted r/g/b value;
                 */
                idx = pix+pix+pix;  /* pix * 3 */

                __wantR = __wR = rgbP[idx] + __eR;
                __wantG = __wG = rgbP[idx+1] + __eG;
                __wantB = __wB = rgbP[idx+2] + __eB;

/*
                if(__wR > 255) __wR = 255;
                else if (__wR < 0) __wR = 0;
                if(__wG > 255) __wG = 255;
                else if (__wG < 0) __wG = 0;
                if(__wB > 255) __wB = 255;
                else if (__wB < 0) __wB = 0;
*/
                /* find the best matching color */

                minDelta = 99999;
                bestIdx = -1;
                dp = __ByteArrayInstPtr(ditherRGBBytes)->ba_element;
                for (idx = 0; idx<__nColors; idx++) {
                    int d, delta;

                    d = dp[0];
                    delta = __wR - d;
                    if (delta < 0) delta = -delta;
                    if (delta < minDelta) {
                        d = dp[1];
                        if (__wG > d) 
                            delta += (__wG - d);
                        else 
                            delta += (d - __wG);
                        if (delta < minDelta) {
                            d = dp[2];
                            if (__wB > d) 
                                delta += (__wB - d);
                            else 
                                delta += (d - __wB);

                            if (delta < minDelta) {
                                bestIdx = idx;
                                if (delta == 0) {
        /*
                                if (delta < 3) {
        */
                                    break;
                                }
                                minDelta = delta;
                            }
                        }
                    }
                    dp += 3;
                }
                dp = __ByteArrayInstPtr(ditherRGBBytes)->ba_element;
                dp += bestIdx * 3;
                dR = dp[0];
                dG = dp[1];
                dB = dp[2];

/*
printf("want: %d/%d/%d (%d/%d/%d) got: %d/%d/%d\n",
                __wantR, __wantG, __wantB,
                __wR, __wG, __wB,
                dR, dG, dB);
*/
                /*
                 * store the corresponding dither colors colorId
                 */
                *dstP++ = idP[bestIdx];

                /*
                 * the new error:
                 */
                __eR = __wantR - dR; 
                __eG = __wantG - dG; 
                __eB = __wantB - dB; 

                /*
                 * distribute the error
                 */
                tR = __eR >> 4;  /* 16th of error */
                tG = __eG >> 4;
                tB = __eB >> 4;

                nR = eP[3] + (tR * 7);/* from accu: error for (x+1 / y) */
                nG = eP[4] + (tG * 7);/* plus 7/16'th of this error */
                nB = eP[5] + (tB * 7);

                eP[0] = tR*5;         /* 5/16th for (x / y+1) */
                eP[1] = tG*5;
                eP[2] = tB*5;

                eP[-3] = tR*3;        /* 3/16th for (x-1 / y+1) */
                eP[-2] = tG*3;
                eP[-1] = tB*3;

                eP[3] = __eR - (tR*15);  /* 1/16th for (x+1 / y+1) */
                eP[4] = __eG - (tG*15);
                eP[5] = __eB - (tB*15);

                __eR = nR;
                __eG = nG;
                __eB = nB;

                eP += 3;
            }
        }
    }
%}.
    failed ifTrue:[
        self primitiveFailed.
        ^ nil
    ].

    ^ pseudoBits


!

floydSteinbergDitheredDepth8BitsColors:fixColors nRed:nRed nGreen:nGreen nBlue:nBlue 
    "return a floyd-steinberg dithered bitmap from the receiver picture,
     which must be a depth-8 image. 
     This is a special-cased dither method for 8-bit palette images being displayed on
     an 8-bit pseudoColor display, AND fixColor dithering is used.
     Use the colors in the fixColors array, which must be fixR x fixG x fixB
     colors assigned to aDevice, such as the preallocated colors of the
     Color class. 
     By passing the ditherColors as extra array, this method can
     also be used to dither an 8bit image into a smaller number of colors,
     for example to create dithered Depth4Images from Depth8Images."

    |pseudoBits  
     rgbBytes
     w       "{Class: SmallInteger }"
     h       "{Class: SmallInteger }"
     index   "{Class: SmallInteger }"
     fixR    "{Class: SmallInteger }"
     fixG    "{Class: SmallInteger }"
     fixB    "{Class: SmallInteger }"
     fixIds failed map lastColor
     error clr|

    self depth ~~ 8 ifTrue:[^ nil].

    fixR := nRed.
    fixR == 0 ifTrue:[ ^ nil].
    fixG := nGreen.
    fixG == 0 ifTrue:[ ^ nil].
    fixB := nBlue.
    fixB == 0 ifTrue:[ ^ nil].

    "/ simple check
    (fixR * fixG * fixB) ~~ fixColors size ifTrue:[
        self error:'invalid color array passed'.
        ^ nil
    ].
    fixIds := (fixColors asArray collect:[:clr | clr colorId]) asByteArray.

    "/
    "/ collect color components as integer values (for integer arithmetic)
    "/
    rgbBytes := ByteArray uninitializedNew:256 * 3.

    index := 1.

    photometric == #palette ifTrue:[
        lastColor := colorMap size - 1
    ] ifFalse:[
        lastColor := 255.
    ].
    0 to:lastColor do:[:pix |
        clr := self colorFromValue:pix.
        rgbBytes at:index put:(clr redByte).
        rgbBytes at:index+1 put:(clr greenByte).
        rgbBytes at:index+2 put:(clr blueByte).

        index := index + 3.
    ].

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

    w := width + 2.
    error := ByteArray uninitializedNew:w*(3*2).

    w := width.
    h := height.

    failed := true.

%{
    int __x, __y;
    int __eR, __eG, __eB;
    unsigned char *srcP, *dstP;
    unsigned char *rgbP;
    unsigned char *idP;
    short *errP, *eP;
    int __fR, __fG, __fB;
    int iR, iG, iB;
    int idx;
    int __w = __intVal(w);

    if (__isByteArray(__INST(bytes))
     && __isByteArray(pseudoBits)
     && __isByteArray(rgbBytes)
     && __isByteArray(fixIds)
     && __isByteArray(error)
     && __bothSmallInteger(fixR, fixG)
     && __isSmallInteger(fixB)) {
        failed = false;

        srcP = __ByteArrayInstPtr(_INST(bytes))->ba_element;
        dstP = __ByteArrayInstPtr(pseudoBits)->ba_element;
        rgbP = __ByteArrayInstPtr(rgbBytes)->ba_element;
        idP = __ByteArrayInstPtr(fixIds)->ba_element;
        errP = (short *) _ByteArrayInstPtr(error)->ba_element;
        __fR = __intVal(fixR)-1;
        __fG = __intVal(fixG)-1;
        __fB = __intVal(fixB)-1;

        /*
         * clear error accumulator
         */
        eP = errP;
        bzero(eP, (__w+2) * 2 * 3);

        for (__y=__intVal(h); __y>0; __y--) {
            __eR = __eG = __eB = 0;

            eP = &(errP[3]);
            __eR = eP[0];
            __eG = eP[1];
            __eB = eP[2];

            for (__x=__w; __x>0; __x--) {
                int __want;
                int pix;
                int __wantR, __wantG, __wantB;
                int idx;
                int tR, tG, tB;
                int nR, nG, nB;

                pix = *srcP++;

                /*
                 * wR, wG and wB is the wanted r/g/b value;
                 */
                idx = pix+pix+pix;  /* pix * 3 */

                __wantR = __want = rgbP[idx]   + __eR;
                if (__want > 255) __want = 255;
                else if (__want < 0) __want = 0;
                iR = (__want * __fR + 128) / 255; /* red index rounded */

                __wantG = __want = rgbP[idx+1] + __eG;
                if (__want > 255) __want = 255;
                else if (__want < 0) __want = 0;
                iG = (__want * __fG + 128) / 255; /* green index rounded */

                __wantB = __want = rgbP[idx+2] + __eB;
                if (__want > 255) __want = 255;
                else if (__want < 0) __want = 0;
                iB = (__want * __fB + 128) / 255; /* blue index rounded */

                idx = iR * (__fG+1);
                idx = (idx + iG) * (__fB+1);
                idx = idx + iB;

                /*
                 * store the corresponding dither colors colorId
                 */
                *dstP++ = idP[idx];

                /*
                 * the new error:
                 */
                __eR = __wantR - (iR * 255 / __fR); 
                __eG = __wantG - (iG * 255 / __fG); 
                __eB = __wantB - (iB * 255 / __fB); 

                /*
                 * distribute the error
                 */
                tR = __eR >> 4;  /* 16th of error */
                tG = __eG >> 4;
                tB = __eB >> 4;

                nR = eP[3] + (tR * 7);/* from accu: error for (x+1 / y) */
                nG = eP[4] + (tG * 7);/* plus 7/16'th of this error */
                nB = eP[5] + (tB * 7);

                eP[0] = tR*5;         /* 5/16th for (x / y+1) */
                eP[1] = tG*5;
                eP[2] = tB*5;

                eP[-3] = tR*3;        /* 3/16th for (x-1 / y+1) */
                eP[-2] = tG*3;
                eP[-1] = tB*3;

                eP[3] = __eR - (tR*15);  /* 1/16th for (x+1 / y+1) */
                eP[4] = __eG - (tG*15);
                eP[5] = __eB - (tB*15);

                __eR = nR;
                __eG = nG;
                __eB = nB;

                eP += 3;
            }
        }
    }
%}.
    failed ifTrue:[
        self primitiveFailed.
        ^ nil
    ].

    ^ pseudoBits


!

floydSteinbergDitheredMonochromeBits
    "return the bitmap for a dithered monochrome bitmap from the image.
     Works for any source depths / photometric, 
     but very very slow since each pixel is processed individually.
     Redefined by some subclasses for more performance (D8Image)"

    |dstIndex        "{Class: SmallInteger }"
     nextDst         "{Class: SmallInteger }"
     bytesPerMonoRow "{Class: SmallInteger }"
     monoBits greyValues
     errorArray
     nextErrorArray
     e eD t
     w               "{Class: SmallInteger }"
     h               "{Class: SmallInteger }"
     bitCnt          "{Class: SmallInteger }"
     byte            "{Class: SmallInteger }" 
     grey dT 
     eR eRB eB eLB |

    w := width.
    h := height.

    bytesPerMonoRow := (w + 7) // 8.
    monoBits := ByteArray uninitializedNew:(bytesPerMonoRow * h).
    (monoBits isNil or:[bytes isNil]) ifTrue:[
        ^ nil
    ].

    errorArray := Array new:w+2.
    nextErrorArray := Array new:w+2.

    nextErrorArray atAllPut:0.

    dstIndex := 1.
    bitCnt := 8.
    byte := 0.

    self depth <= 12 ifTrue:[
        "/ fetch scaled brightness values outside of loop into a table;
        "/ use table-value in loop

        greyValues := self greyMapForRange:(255 * 1024).
        greyValues := greyValues collect:[:v | v isNil ifTrue:[
                                                   0
                                               ] ifFalse:[
                                                   v rounded
                                               ]].

        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerMonoRow.

            t := errorArray.
            errorArray := nextErrorArray.
            nextErrorArray := t.

            nextErrorArray atAllPut:0.

            self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
%{
                int __grey, __e;
                int __byte = __intVal(byte);
                OBJ *__errorArray = __ArrayInstPtr(errorArray)->a_element;
                OBJ *__nextErrorArray = __ArrayInstPtr(nextErrorArray)->a_element;
                int __x = __intVal(x);
                int __eR, __eB, __eRB, __eLB, __eI;
                int __bitCnt = __intVal(bitCnt);

                __grey = __intVal(__ArrayInstPtr(greyValues)->a_element[__intVal(pixel)]);
                __grey += __intVal(__errorArray[__x+1]);
                
                __byte <<= 1;
                if (__grey > 127*1024) {
                    __e = __grey - (255*1024);
                    __byte |= 1;
                } else {
                    __e = __grey;
                }
                if (__e) {
                    __eI = __e >> 4;
                    __eR  = __eI * 7;            
                    __eRB = __eI * 1;            
                    __eB  = __eI * 5;            
                    __eLB = __e - __eR - __eRB - __eB;
                    __errorArray[__x+2] = __MKSMALLINT(__intVal(__errorArray[__x+2]) + __eR);
                    __nextErrorArray[__x+2] = __MKSMALLINT(__intVal(__nextErrorArray[__x+2]) + __eRB);
                    __nextErrorArray[__x+1] = __MKSMALLINT(__intVal(__nextErrorArray[__x+1]) + __eB);
                    __nextErrorArray[__x  ] = __MKSMALLINT(__intVal(__nextErrorArray[__x  ]) + __eLB);

                }
                __bitCnt--;
                if (__bitCnt == 0) {
                    int __dstIndex = __intVal(dstIndex);

                    __ByteArrayInstPtr(monoBits)->ba_element[__dstIndex-1] = __byte;
                    dstIndex = __MKSMALLINT(__dstIndex + 1);
                    __byte = 0;
                    __bitCnt = 8;
                }
                byte = __MKSMALLINT(__byte);
                bitCnt = __MKSMALLINT(__bitCnt);
%}.

"/                |eI "{ Class: SmallInteger }" 
"/                 xE "{ Class: SmallInteger }" 
"/                 xN "{ Class: SmallInteger }" |
"/
"/                "/ get the colors grey value [0 .. 1]
"/                grey := greyValues at:(pixel + 1).
"/
"/                "/ adjust error
"/                xE := x + 2.
"/                grey := (grey + (errorArray at:xE)).
"/
"/                byte := byte bitShift:1.
"/                grey > (127*1024) ifTrue:[
"/                    byte := byte bitOr:1.      "/ white
"/                    e := grey - (255*1024)
"/                ] ifFalse:[
"/                    e := grey                  "/ black
"/                ].
"/                e ~= 0 ifTrue:[
"/                    eD := e.
"/                    eI := e // 16.
"/
"/                    eR  := eI * 7.              "/ 7/16 to right
"/                    eRB := eI * 1.              "/ 1/16 to right below
"/                    eB  := eI * 5.              "/ 5/16 to below
"/                    eLB := eD - eR - eRB - eB.  "/ 3/16 to left below
"/
"/                    xN := xE + 1.
"/                    eR ~= 0 ifTrue:[
"/                        errorArray     at:xN put:(errorArray at:xN) + eR.
"/                    ].
"/                    eRB ~= 0 ifTrue:[
"/                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB.
"/                    ].
"/                    eB ~= 0 ifTrue:[
"/                        nextErrorArray at:xE put:(nextErrorArray at:xE) + eB.
"/                    ].
"/                    eLB ~= 0 ifTrue:[
"/                        xN := xE - 1.
"/                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB.
"/                    ].
"/                ].
"/
"/                bitCnt := bitCnt - 1.
"/                bitCnt == 0 ifTrue:[
"/                    monoBits at:dstIndex put:byte.
"/                    dstIndex := dstIndex + 1.
"/                    byte := 0.
"/                    bitCnt := 8.
"/                ].
                  0
            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                monoBits at:dstIndex put:byte.
                bitCnt := 8.
                byte := 0.
            ].

            dstIndex := nextDst.
        ].
    ] ifFalse:[
        'IMAGE: slow floydSteinberg dither ..' infoPrintCR.

        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerMonoRow.

            t := errorArray.
            errorArray := nextErrorArray.
            nextErrorArray := t.

            nextErrorArray atAllPut:0.

            self colorsAtY:y from:0 to:(w-1) do:[:x :clr |
                |eI "{ Class: SmallInteger }" 
                 xE "{ Class: SmallInteger }" 
                 xN "{ Class: SmallInteger }" |

                "/ get the colors grey value [0 .. 1]
                grey := (clr brightness * 255).

                "/ adjust error
                xE := x + 2.
                grey := (grey + (errorArray at:xE)) rounded.

                byte := byte bitShift:1.
                grey > 127 ifTrue:[
                    byte := byte bitOr:1.      "/ white
                    e := grey - 255
                ] ifFalse:[
                    e := grey                  "/ black
                ].

                e ~= 0 ifTrue:[
                    eD := e.
                    eI := e // 16.
                    eR  := eI * 7.              "/ 7/16 to right
                    eRB := eI * 1.              "/ 1/16 to right below
                    eB  := eI * 5.              "/ 5/16 to below
                    eLB := eD - eR - eRB - eB.  "/ 3/16 to left below

                    xN := xE + 1.
                    eR ~= 0 ifTrue:[
                        errorArray     at:xN put:(errorArray at:xN) + eR.
                    ].
                    eRB ~= 0 ifTrue:[
                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB.
                    ].
                    eB ~= 0 ifTrue:[
                        nextErrorArray at:xE put:(nextErrorArray at:xE) + eB.
                    ].
                    eLB ~= 0 ifTrue:[
                        xN := xE - 1.
                        nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB.
                    ].
                ].

                bitCnt := bitCnt - 1.
                bitCnt == 0 ifTrue:[
                    monoBits at:dstIndex put:byte.
                    dstIndex := dstIndex + 1.
                    byte := 0.
                    bitCnt := 8.
                ].

            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                monoBits at:dstIndex put:byte.
                bitCnt := 8.
                byte := 0.
            ].

            dstIndex := nextDst.
        ].
    ].

    ^ monoBits

    "Created: 8.6.1996 / 16:39:46 / cg"
    "Modified: 10.6.1996 / 15:12:11 / cg"
!

orderedDitheredBitsDepth:depth
    "return the bitmap for a dithered depth-bitmap from the image"

    ^ self
        orderedDitheredBitsWithDitherMatrix:(self class orderedDitherMatrixOfSize:8)
        ditherWidth:8
        depth:depth.

    "Created: 15.6.1996 / 09:18:04 / cg"
!

orderedDitheredBitsWithDitherMatrix:ditherMatrix ditherWidth:dW depth:depth
    "return the bitmap for a dithered depth-bitmap from the image;
     with a constant ditherMatrix, this can be used for thresholding.
     Works for any source depths / photometric, 
     but very very slow since each pixel is processed individually.
     Redefined by some subclasses for more performance (D8Image)"

    |f last dH nDither   
     greyLevels greyValues greyPixels greyErrors
     dstIndex        "{Class: SmallInteger }"
     nextDst         
     bytesPerOutRow  "{Class: SmallInteger }"
     pixelsPerByte   "{Class: SmallInteger }"
     outBits
     w               "{Class: SmallInteger }"
     h               "{Class: SmallInteger }"
     bitCnt          "{Class: SmallInteger }"
     byte            "{Class: SmallInteger }" |

    depth > 8 ifTrue:[
        'IMAGE: unimplemented orderedDither conversion' errorPrintCR.
        ^ nil
    ].

    nDither := ditherMatrix size.
    dH := nDither / dW.

    w := width.
    h := height.

    greyLevels := 1 bitShift:depth.
    pixelsPerByte := 8 / depth.

    bytesPerOutRow := (w * depth + 7) // 8.
    outBits := ByteArray uninitializedNew:(bytesPerOutRow * h).
    (outBits isNil or:[bytes isNil]) ifTrue:[
        ^ nil
    ].

    dstIndex := 1.

    self bitsPerPixel <= 12 ifTrue:[
        "/ fetch scaled brightness values outside of loop into a table;
        "/ use table-value in loop

        greyValues := self greyMapForRange:(greyLevels-1).
        greyPixels := greyValues collect:[:v | v isNil ifTrue:[
                                                   0
                                               ] ifFalse:[
                                                   v truncated]].
        greyPixels := ByteArray withAll:greyPixels.

        greyErrors := greyValues collect:[:v | v isNil ifTrue:[
                                                   0
                                               ] ifFalse:[
                                                   ((v - v truncated) * nDither) rounded
                                               ]].
        greyErrors := ByteArray withAll:greyErrors.

        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerOutRow.
            byte := 0.
            bitCnt := 8.

            self valuesAtY:y from:0 to:(w-1) do:[:x :value |
%{
                int __dW = __intVal(dW);
                int __byte = __intVal(byte);
                int __value = __intVal(value);
                int __dT;
                int __dstIdx;
                int __pixel, __grey;
                int __bitCnt = __intVal(bitCnt);
                unsigned char *__greyPixels = __ByteArrayInstPtr(greyPixels)->ba_element;
                unsigned char *__greyErrors = __ByteArrayInstPtr(greyErrors)->ba_element;

                __pixel = __greyPixels[__value];
                __grey = __greyErrors[__value];

                __dT = __ByteArrayInstPtr(ditherMatrix)
                            ->ba_element[__intVal(x) % __dW 
                                         + (__intVal(y) % __intVal(dH)) * __dW];

                if (__grey > __dT) {
                    __pixel++;
                }
                __byte = (__byte << __intVal(depth)) | __pixel;

                __bitCnt = __bitCnt - __intVal(depth);
                if (__bitCnt == 0) {
                    __dstIdx = __intVal(dstIndex);
                    __ByteArrayInstPtr(outBits)->ba_element[__dstIdx-1] = __byte;
                    __dstIdx = __dstIdx + 1;
                    dstIndex = __MKSMALLINT(__dstIdx);
                    __byte = 0;
                    __bitCnt = 8;
                }
                byte = __MKSMALLINT(__byte);
                bitCnt = __MKSMALLINT(__bitCnt);
%}.
                0

            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                outBits at:dstIndex put:byte.
            ].
            dstIndex := nextDst.
        ].
    ] ifFalse:[
        Transcript showCR:'slow ordered dither ..'. Transcript endEntry.

        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerOutRow.
            byte := 0.
            bitCnt := 8.

            "/ this is the representaion independent (but slow)
            "/ inner loop - it extracts colors from the receiver
            
            self colorsAtY:y from:0 to:(w-1) do:[:x :clr |
                |dstClr grey dT pixel|

                "/ get the colors grey value [0 .. 1]
                grey := clr brightness.

                "/ remap into [0 .. greyLevels-1]
                grey := grey * (greyLevels-1).
            
                "/ get threshold pixel [0 .. greyLevels-1]

                pixel := grey truncated.  

                "/ compute the error [0..1]
                grey := grey - pixel.

                "/ map into dither space [0 .. nDither]
                grey := (grey * (nDither)) rounded.

%{
                int __dW = __intVal(dW);
                int __byte = __intVal(byte);
                int __dT;
                int __dstIdx;
                int __pixel;
                int __bitCnt = __intVal(bitCnt);

                __dT = __ByteArrayInstPtr(ditherMatrix)
                            ->ba_element[__intVal(x) % __dW 
                                         + (__intVal(y) % __intVal(dH)) * __dW];

                __pixel = __intVal(pixel);

                if (__intVal(grey) > __dT) {
                    __pixel++;
                }
                __byte = (__byte << __intVal(depth)) | __pixel;
            
                __bitCnt = __bitCnt - __intVal(depth);
                if (__bitCnt == 0) {
                    __dstIdx = __intVal(dstIndex);
                    __ByteArrayInstPtr(outBits)->ba_element[__dstIdx-1] = __byte;
                    __dstIdx = __dstIdx + 1;
                    dstIndex = __MKSMALLINT(__dstIdx);
                    __byte = 0;
                    __bitCnt = 8;
                }
                byte = __MKSMALLINT(__byte);
                bitCnt = __MKSMALLINT(__bitCnt);
%}.
                0

            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                outBits at:dstIndex put:byte.
            ].
            dstIndex := nextDst.
        ].
    ].
    ^ outBits
!

orderedDitheredMonochromeBits
    "return the bitmap for a dithered monochrome bitmap from the image;
     using a default ditherMatrix."

    ^ self
        orderedDitheredMonochromeBitsWithDitherMatrix:(self class orderedDitherMatrixOfSize:8)
        ditherWidth:8

    "Created: 11.6.1996 / 16:48:57 / cg"
!

orderedDitheredMonochromeBitsWithDitherMatrix:ditherMatrix ditherWidth:dW
    "return the bitmap for a dithered monochrome bitmap from the image;
     with a constant ditherMatrix, this can be used for thresholding.
     Works for any source depths / photometric, 
     but very very slow since each pixel is processed individually.
     Redefined by some subclasses for more performance (D8Image)"

    |f last dH nDither   
     greyValues
     dstIndex        "{Class: SmallInteger }"
     nextDst         "{Class: SmallInteger }"
     bytesPerMonoRow "{Class: SmallInteger }"
     monoBits
     w               "{Class: SmallInteger }"
     h               "{Class: SmallInteger }"
     bitCnt          "{Class: SmallInteger }"
     byte            "{Class: SmallInteger }" |

    nDither := ditherMatrix size.
    dH := nDither / dW.

    w := width.
    h := height.

    bytesPerMonoRow := (w + 7) // 8.
    monoBits := ByteArray uninitializedNew:(bytesPerMonoRow * h).
    (monoBits isNil or:[bytes isNil]) ifTrue:[
        ^ nil
    ].

    dstIndex := 1.

    self bitsPerPixel <= 12 ifTrue:[
        "/ fetch scaled brightness values outside of loop into a table;
        "/ use table-value in loop

        greyValues := self greyByteMapForRange:nDither.

        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerMonoRow.
            byte := 0.
            bitCnt := 8.
            self valuesAtY:y from:0 to:(w-1) do:[:x :value |
%{
                int __dW = __intVal(dW);
                int __byte = __intVal(byte);
                int __dT;
                int __dstIdx;
                int __bitCnt = __intVal(bitCnt);
                int __grey;
                unsigned char *__greyValues = __ByteArrayInstPtr(greyValues)->ba_element;

                __grey = __greyValues[__intVal(value)];

                __dT = __ByteArrayInstPtr(ditherMatrix)
                            ->ba_element[__intVal(x) % __dW 
                                         + (__intVal(y) % __intVal(dH)) * __dW];

                __byte = __byte << 1;
                if (__grey > __dT) {
                    __byte = __byte | 1;            /* white */
                }
                __bitCnt = __bitCnt - 1;
                if (__bitCnt == 0) {
                    __dstIdx = __intVal(dstIndex);
                    __ByteArrayInstPtr(monoBits)->ba_element[__dstIdx-1] = __byte;
                    __dstIdx = __dstIdx + 1;
                    dstIndex = __MKSMALLINT(__dstIdx);
                    __byte = 0;
                    __bitCnt = 8;
                }
                byte = __MKSMALLINT(__byte);
                bitCnt = __MKSMALLINT(__bitCnt);
%}.
                0
            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                monoBits at:dstIndex put:byte.
            ].
            dstIndex := nextDst.
        ].
    ] ifFalse:[
        Transcript showCR:'slow ordered dither ..'. Transcript endEntry.

        0 to:(h-1) do:[:y |
            nextDst := dstIndex + bytesPerMonoRow.
            byte := 0.
            bitCnt := 8.
            self colorsAtY:y from:0 to:(w-1) do:[:x :clr |
                |dstClr grey dT|

                "/ get the colors grey value [0 .. 1]
                grey := clr brightness.

                "/ map into dither space [0 .. nDither]
                grey := (grey * (nDither)) rounded.

%{
                int __dW = __intVal(dW);
                int __byte = __intVal(byte);
                int __dT;
                int __dstIdx;
                int __bitCnt = __intVal(bitCnt);

                __dT = __ByteArrayInstPtr(ditherMatrix)
                            ->ba_element[__intVal(x) % __dW 
                                         + (__intVal(y) % __intVal(dH)) * __dW];

                __byte = __byte << 1;
                if (__intVal(grey) > __dT) {
                    __byte = __byte | 1;            /* white */
                }
                __bitCnt = __bitCnt - 1;
                if (__bitCnt == 0) {
                    __dstIdx = __intVal(dstIndex);
                    __ByteArrayInstPtr(monoBits)->ba_element[__dstIdx-1] = __byte;
                    __dstIdx = __dstIdx + 1;
                    dstIndex = __MKSMALLINT(__dstIdx);
                    __byte = 0;
                    __bitCnt = 8;
                }
                byte = __MKSMALLINT(__byte);
                bitCnt = __MKSMALLINT(__bitCnt);
%}.
                0

"/                dT := ditherMatrix at:(x \\ dW) + (y \\ dH * dW) + 1.
"/     
"/                byte := byte bitShift:1.
"/                grey < dT ifTrue:[
"/                    byte := byte bitOr:1.
"/                ].
"/                bitCnt := bitCnt - 1.
"/                bitCnt == 0 ifTrue:[
"/                    monoBits at:dstIndex put:byte.
"/                    dstIndex := dstIndex + 1.
"/                    byte := 0.
"/                    bitCnt := 8.
"/                ].

            ].
            bitCnt ~~ 8 ifTrue:[
                byte := byte bitShift:bitCnt.
                monoBits at:dstIndex put:byte.
            ].
            dstIndex := nextDst.
        ].
    ].
    ^ monoBits
!

stevensonArceDitheredMonochromeBits
    "return the bitmap for a dithered monochrome bitmap from the image.
     Works for any source depths / photometric"

    |f last    
     dstIndex        "{Class: SmallInteger }"
     nextDst         "{Class: SmallInteger }"
     bytesPerMonoRow "{Class: SmallInteger }"
     monoBits greyValues
     errorArray
     errorArray1 errorArray2 errorArray3
     e t
     w               "{Class: SmallInteger }"
     h               "{Class: SmallInteger }"
     bitCnt          "{Class: SmallInteger }"
     byte            "{Class: SmallInteger }" 
     direction       "{Class: SmallInteger }"
     dstClr grey dT 
     xE              "{Class: SmallInteger }" 
     xN              "{Class: SmallInteger }"
     eR eRB eB eLB |

    self depth > 12 ifTrue:[
        ^ self floydSteinbergDitheredMonochromeBits
    ].

    w := width.
    h := height.

    bytesPerMonoRow := (w + 7) // 8.
    monoBits := ByteArray uninitializedNew:(bytesPerMonoRow * h).
    (monoBits isNil or:[bytes isNil]) ifTrue:[
        ^ nil
    ].

    errorArray := Array new:(w+6).
    errorArray1 := Array new:(w+6) withAll:0.
    errorArray2 := Array new:(w+6) withAll:0.
    errorArray3 := Array new:(w+6) withAll:0.

    dstIndex := 1.

    "/ fetch scaled brightness values outside of loop into a table;
    "/ use table-value in loop

    greyValues := self greyMapForRange:(255 * 1024).
    
    0 to:(h-1) do:[:y |
        nextDst := dstIndex + bytesPerMonoRow.
        byte := 0.
        bitCnt := 8.

        t := errorArray.
        errorArray := errorArray1.
        errorArray1 := errorArray2.
        errorArray2 := errorArray3.
        errorArray3 := t.

        errorArray3 atAllPut:0.

        self valuesAtY:y from:0 to:(w-1) do:[:x :pixel |
            |eP eD|

            "/ get the colors grey value [0 .. 1]
            grey := greyValues at:(pixel + 1).

            "/ adjust error
            xE := x + 3 + 1.
            grey := (grey + (errorArray at:xE)).

            byte := byte bitShift:1.
            grey > (127 * 1024) ifTrue:[
                byte := byte bitOr:1.      "/ white
                e := grey - (255 * 1024)
            ] ifFalse:[
                e := grey                  "/ black
            ].

            e ~= 0 ifTrue:[
                "/ distribute the error:
                "/                  XX    32
                "/         12    26    30    16
                "/            12    26    12
                "/          5    12    12     5

                eD := e.
                e := e // 200.

                eP := e * 32. eD := eD - eP.
                errorArray at:xE+2 put:(errorArray at:xE+2) + eP.

                eP := e * 30. eD := eD - eP.
                errorArray1 at:xE+1 put:(errorArray1 at:xE+1) + eP.

                eP := e * 16. eD := eD - eP.
                errorArray1 at:xE+3 put:(errorArray1 at:xE+3) + eP.

                eP := e * 26. eD := eD - eP.
                errorArray1 at:xE-1 put:(errorArray1 at:xE-1) + eP.

                eD := eD - eP.
                errorArray2 at:xE put:(errorArray2 at:xE) + eP.

                eP := e * 12. eD := eD - eP.
                errorArray1 at:xE-3 put:(errorArray1 at:xE-3) + eP.

                eD := eD - eP.
                errorArray2 at:xE-2 put:(errorArray2 at:xE-2) + eP.

                eD := eD - eP.
                errorArray2 at:xE+2 put:(errorArray2 at:xE+2) + eP.

                eD := eD - eP.
                errorArray3 at:xE-1 put:(errorArray3 at:xE-1) + eP.

                eD := eD - eP.
                errorArray3 at:xE+1 put:(errorArray3 at:xE+1) + eP.

                eP := e * 5. eD := eD - eP.
                errorArray3 at:xE-3 put:(errorArray3 at:xE-3) + eP.

                eP := eD.
                errorArray3 at:xE+3 put:(errorArray3 at:xE+3) + eP.
            ].

            bitCnt := bitCnt - 1.
            bitCnt == 0 ifTrue:[
                monoBits at:dstIndex put:byte.
                dstIndex := dstIndex + 1.
                byte := 0.
                bitCnt := 8.
            ].

        ].
        bitCnt ~~ 8 ifTrue:[
            byte := byte bitShift:bitCnt.
            monoBits at:dstIndex put:byte.
        ].

        dstIndex := nextDst.
    ].

    ^ monoBits

    "Created: 10.6.1996 / 12:38:35 / cg"
    "Modified: 10.6.1996 / 12:52:20 / cg"
! !

!Image methodsFor:'drawing'!

fillRectangleX:x y:y width:w height:h with:aColor
    |pixel 
     xI "{ Class: SmallInteger }"
     yI "{ Class: SmallInteger }"
     wI "{ Class: SmallInteger }" 
     hI "{ Class: SmallInteger }"|

    pixel := self valueFromColor:aColor.
    xI := x.
    yI := y.
    wI := w.
    hI := h.
    yI to:yI+hI-1 do:[:yRun |
        xI to:xI+wI-1 do:[:xRun |
            self atX:xRun y:yRun putValue:pixel
        ]
    ]

    "Created: 15.6.1996 / 08:41:25 / cg"
    "Modified: 15.6.1996 / 10:08:15 / cg"
! !

!Image methodsFor:'enumerating'!

atY:y from:x1 to:x2 do:aBlock
    "perform aBlock for each pixel from x1 to x2 in row y.
     The block is passed the color at each pixel.
     The code here provides a generic and slow implementation, and
     should be redefined in concrete subclasses, to avoid some processing
     when going from pixel to pixel (i.e. the byte-index and mask computations
     and also the color allocation)."

    self obsoleteMethodWarning:'use #colorsAtY:from:to:do:'.
    self colorsAtY:y from:x1 to:x2 do:aBlock

    "Modified: 7.6.1996 / 19:13:30 / cg"
!

colorsAtY:y from:x1 to:x2 do:aBlock
    "perform aBlock for each pixel from x1 to x2 in row y.
     The block is passed the color at each pixel.
     The code here provides a generic and slow implementation, and
     should be redefined in concrete subclasses, to avoid some processing
     when going from pixel to pixel (i.e. the byte-index and mask computations
     and also the color allocation)."

    |xStart "{Class: SmallInteger }"
     xEnd   "{Class: SmallInteger }"|

    xStart := x1.
    xEnd := x2.
    xStart to:xEnd do:[:xRun |
        aBlock value:xRun value:(self atX:xRun y:y)
    ]

    "Created: 7.6.1996 / 19:12:51 / cg"
    "Modified: 10.6.1996 / 10:27:29 / cg"
!

colorsFromX:xStart y:yStart toX:xEnd y:yEnd do:aBlock
    "perform aBlock for each color in a rectangular area of the image.
     Notice, that x and y coordinates start at 0@0 for the upper left corner.
     The block is passed the x and y coordinates and pixelValue at each pixel.
     The code here provides a generic and slow implementation, and
     should be redefined in concrete subclasses, to avoid some processing
     when going from pixel to pixel (i.e. the byte-index and mask computations,
     and especially, the color allocations)."

    |xS "{Class: SmallInteger }"
     xE "{Class: SmallInteger }"|

    xS := xStart.
    xE := xEnd.
    yStart to:yEnd do:[:yRun |    
        self colorsAtY:yRun from:xStart to:xEnd do:[:xRun :color |
            aBlock value:xRun value:yRun value:color 
        ]
    ]

    "Modified: 7.6.1996 / 19:11:39 / cg"
!

valueAtY:y from:x1 to:x2 do:aBlock
    "perform aBlock for each pixelValue from x1 to x2 in row y.
     Obsolete - remains for backward compatibility."

    self obsoleteMethodWarning:'use #valuesAtY:from:to:do:'.
    self valuesAtY:y from:x1 to:x2 do:aBlock

    "Modified: 7.6.1996 / 19:11:06 / cg"
!

valuesAtY:y from:x1 to:x2 do:aBlock
    "perform aBlock for each pixelValue from x1 to x2 in row y.
     Notice, that x and y coordinates start at 0@0 for the upper left corner.
     The block is passed the x coordinate and the pixelValue at each pixel.
     (see also Image>>atY:from:to:do:).
     The code here provides a generic and slow implementation, and
     should be redefined in concrete subclasses, to avoid some processing
     when going from pixel to pixel (i.e. the byte-index and mask computations)."

    |xStart "{Class: SmallInteger }"
     xEnd   "{Class: SmallInteger }"|

    xStart := x1.
    xEnd := x2.
    xStart to:xEnd do:[:xRun |
        aBlock value:xRun value:(self valueAtX:xRun y:y)
    ]

    "Modified: 17.5.1996 / 12:03:59 / cg"
    "Created: 7.6.1996 / 19:09:51 / cg"
!

valuesFromX:xStart y:yStart toX:xEnd y:yEnd do:aBlock
    "perform aBlock for each pixelValue in a rectangular area of the image.
     Notice, that x and y coordinates start at 0@0 for the upper left corner.
     The block is passed the x and y coordinates and pixelValue at each pixel.
     The code here provides a generic and slow implementation, and
     should be redefined in concrete subclasses, to avoid some processing
     when going from pixel to pixel (i.e. the byte-index and mask computations)."

    |xS "{Class: SmallInteger }"
     xE "{Class: SmallInteger }"|

    xS := xStart.
    xE := xEnd.
    yStart to:yEnd do:[:yRun |    
        self valuesAtY:yRun from:xStart to:xEnd do:[:xRun :pixel |
            aBlock value:xRun value:yRun value:pixel
        ]
    ]

    "Modified: 7.6.1996 / 19:09:29 / cg"
! !

!Image methodsFor:'image manipulations'!

colorMapProcessing:aBlock
    "a helper for all kinds of colormap manipulations.
     The argument, aBlock is called for every colormap entry, 
     and the returned value will replace the original entry in the map.
     This will fail for non-palette images.
     See examples in Image>>copyWithColorMapProcessing:"

    |nColors "{ Class: SmallInteger }"|

    colorMap isNil ifTrue:[
        ^ self error:'image has no colormap'
    ].

    nColors := colorMap size.
    1 to:nColors do:[:index |
        |clr|

        clr := colorMap at:index.
        clr notNil ifTrue:[
            colorMap at:index put:(aBlock value:clr)
        ]
    ]

    "Modified: 23.4.1996 / 11:13:55 / cg"
!

copyWithColorMapProcessing:aBlock
    "a helper to create & return new images based on the receiver with
     some colorMap processing. The receiver is copied, and the copied images
     colormap is modified by replacing entries with the result of the processing block,
     which is called with the original color values. The block is supposed to return
     a color."

    |newImage|

    newImage := self copy.
    newImage colorMap isNil ifTrue:[
	self error:'no colormap in image'.
	^ nil
    ].

    "
     the code below manipulates the colormap.
     For non-palette images, special code is required
    "
    newImage colorMapProcessing:aBlock.
    ^ newImage

    "
     leave red component only:

     (Image fromFile:'bitmaps/claus.gif') 
	copyWithColorMapProcessing:[:clr | Color red:(clr red) green:0 blue:0] 
    "

    "
     make it reddish:

     (Image fromFile:'bitmaps/claus.gif') 
	copyWithColorMapProcessing:[:clr | Color red:((clr red * 2) min:100) green:clr green blue:clr blue] 
    "

    "
     invert:

     (Image fromFile:'bitmaps/claus.gif') 
	copyWithColorMapProcessing:[:clr | Color red:(100 - clr red) green:(100 - clr green) blue:(100 - clr green)] 
    "

    "
     lighter:

     (Image fromFile:'bitmaps/claus.gif') 
	copyWithColorMapProcessing:[:clr | |r g b|
						r := clr red.  g := clr green.  b := clr blue.
						Color red:(r + (100-r//2)) 
						      green:(g + (100-g//2)) 
						      blue:(b + (100-b//2))]
    "

    "
     darker:

     (Image fromFile:'bitmaps/claus.gif') 
	copyWithColorMapProcessing:[:clr | Color red:(clr red//2) green:(clr green // 2) blue:(clr blue // 2)] 
    "
!

darkened
    "return a new image which is slightly darker than the receiver.
     The receiver must be a palette image (currently).
     CAVEAT: Need an argument, which specifies by how much it should be darker."

     ^ self 
        copyWithColorMapProcessing:[:clr | 
                Color red:(clr red // 2) 
                    green:(clr green // 2) 
                     blue:(clr blue // 2)] 

    "
     (Image fromFile:'bitmaps/claus.gif') inspect
     (Image fromFile:'bitmaps/claus.gif') darkened inspect
    "

    "Modified: 23.4.1996 / 11:14:34 / cg"
!

flipHorizontal
    "inplace horizontal flip"

    |w  "{Class: SmallInteger }"
     h  "{Class: SmallInteger }"
     c2 "{Class: SmallInteger }" 
     value |

    w := width - 1.
    h := height - 1.

    0 to:h do:[:row |
	c2 := w.
	0 to:(w // 2) do:[:col |
	    value := self valueAtX:col y:row.
	    self atX:col y:row putValue:(self valueAtX:c2 y:row).
	    self atX:c2 y:row putValue:value.
	    c2 := c2 - 1.
	]
    ].
    "flush device info"
    self restored
!

flipVertical
    "inplace vertical flip"

    |h           "{Class: SmallInteger }"
     bytesPerRow "{Class: SmallInteger }"
     buffer 
     indexLow    "{Class: SmallInteger }"
     indexHi     "{Class: SmallInteger }"|

    bytesPerRow := self bytesPerRow.
    buffer := ByteArray new:bytesPerRow.

    h := height - 1.

    indexLow := 1.
    indexHi := bytesPerRow * h + 1.

    0 to:(h // 2) do:[:row |
	buffer replaceFrom:1 to:bytesPerRow with:bytes startingAt:indexLow.
	bytes replaceFrom:indexLow to:(indexLow + bytesPerRow - 1) with:bytes startingAt:indexHi.
	bytes replaceFrom:indexHi to:(indexHi + bytesPerRow - 1) with:buffer startingAt:1.
	indexLow := indexLow + bytesPerRow.
	indexHi := indexHi - bytesPerRow.
    ].
    "flush device info"
    self restored
!

hardMagnifiedBy:scalePoint
    "return a new image magnified by scalePoint, aPoint.
     This is the general magnification method, handling non-integral values.
     It is slower than the integral magnification method."

    |mX        
     mY        
     newWidth  "{ Class: SmallInteger }"
     newHeight "{ Class: SmallInteger }"
     w         "{ Class: SmallInteger }"
     h         "{ Class: SmallInteger }"
     newImage newBits bitsPerPixel newBytesPerRow
     value srcRow|

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

    newWidth := (width * mX) truncated.
    newHeight := (height * mY) truncated.

    bitsPerPixel := self depth.
    newBytesPerRow := ((newWidth * bitsPerPixel) + 7) // 8.
    newBits := ByteArray uninitializedNew:(newBytesPerRow * newHeight).

    newImage := self species new.
    newImage bits:newBits.
    newImage width:newWidth.
    newImage height:newHeight.
    newImage photometric:photometric.
    newImage samplesPerPixel:samplesPerPixel.
    newImage bitsPerSample:bitsPerSample.
    newImage colorMap:colorMap copy.

    "walk over destination image fetching pixels from source image"

    w := newWidth - 1.
    h := newHeight - 1.

    0 to:h do:[:row |
	srcRow := (row // mY).
	0 to:w do:[:col |
	    value := self valueAtX:(col // mX) y:srcRow.
	    newImage atX:col y:row putValue:value.
	]
    ].

    ^ newImage

    "((Image fromFile:'bitmaps/claus.gif') magnifiedBy:0.5@0.5)"
!

hardRotated:degrees
    "raise an error - rotation by arbitrary angles is not yet implemented"

    self error:'not yet implemented'

    "Modified: 23.4.1996 / 11:15:33 / cg"
!

lightened
    "return a new image which is slightly brighter than the receiver.
     The receiver must be a palette image (currently).
     CAVEAT: Need an argument, which specifies by how much it should be lighter."

     ^ self 
        copyWithColorMapProcessing:[:clr | |r g b|
                                           r := clr red. 
                                           g := clr green. 
                                           b := clr blue.
                                           Color red:(r + (100-r//2)) 
                                                 green:(g + (100-g//2))
                                                 blue:(b + (100-b//2))]

    "
     (Image fromFile:'bitmaps/claus.gif') inspect
     (Image fromFile:'bitmaps/claus.gif') lightened inspect
     (Image fromFile:'bitmaps/claus.gif') darkened inspect
     (Image fromFile:'bitmaps/claus.gif') darkened darkened inspect
    "

    "Modified: 23.4.1996 / 11:14:41 / cg"
!

magnifiedBy:scale
    "return a new image magnified by scalePoint, aPoint.
     If non-integral magnify is asked for, pass the work on to 'hardMagnifyBy:'
     while simple (integral) magnifications are handled here."

    |scalePoint mX mY
     magX      "{ Class: SmallInteger }"   "new version of stc can find this out itself..."
     magY      "{ Class: SmallInteger }"
     srcOffset "{ Class: SmallInteger }"
     dstOffset "{ Class: SmallInteger }"
     w         "{ Class: SmallInteger }"
     h         "{ Class: SmallInteger }"
     first
     newWidth newHeight newImage newBits 
     bitsPerPixel newBytesPerRow oldBytesPerRow|

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

    ((mX isMemberOf:SmallInteger) and:[mY isMemberOf:SmallInteger]) ifFalse:[
	^ self hardMagnifiedBy:scalePoint
    ].

    bitsPerPixel := self depth.
    oldBytesPerRow := ((width * bitsPerPixel) + 7) // 8.

    w := width.
    h := height.
    magX := mX.
    magY := mY.

    newWidth := w * mX.
    newHeight := h * mY.
    newBytesPerRow := ((newWidth * bitsPerPixel) + 7) // 8.
    newBits := ByteArray uninitializedNew:(newBytesPerRow * newHeight).

    newImage := self species new.
    newImage bits:newBits.
    newImage width:newWidth.
    newImage height:newHeight.
    newImage photometric:photometric.
    newImage samplesPerPixel:samplesPerPixel.
    newImage bitsPerSample:bitsPerSample.
    newImage colorMap:colorMap copy.

    mX = 1 ifTrue:[
	"expand rows only"
	srcOffset := 1.
	dstOffset := 1.

	1 to:h do:[:row |
	    1 to:mY do:[:i |
		newBits replaceFrom:dstOffset 
			to:(dstOffset + oldBytesPerRow - 1)
			with:bytes 
			startingAt:srcOffset.
		dstOffset := dstOffset + newBytesPerRow
	    ].
	    srcOffset := srcOffset + oldBytesPerRow.
	].
    ] ifFalse:[
	"expand cols"
	(mX > 1) ifTrue:[
	    dstOffset := 1.
	    srcOffset := 1.
	    1 to:h do:[:row |
		self magnifyRowFrom:bytes 
		     offset:srcOffset  
		     into:newBits 
		     offset:dstOffset 
		     factor:mX.

		first := dstOffset.
		dstOffset := dstOffset + newBytesPerRow.
		" and copy for row expansion "
		2 to:mY do:[:i |
		    newBits replaceFrom:dstOffset 
			    to:(dstOffset + newBytesPerRow - 1)
			    with:newBits 
			    startingAt:first.
		    dstOffset := dstOffset + newBytesPerRow
		].
		srcOffset := srcOffset + oldBytesPerRow.
	    ].
	]
    ].
    ^ newImage

    "((Image fromFile:'bitmaps/claus.gif') magnifiedBy:1@2)"
!

magnifiedPreservingRatioTo:anExtent 
    "return a new image magnified to fit into anExtent,
     preserving the receivers width/height ratio.
     (i.e. not distorting the image).
     See also #magnifiedTo: and #magnifiedBy:"

    |rX rY|

    rX := anExtent x / self width.
    rY := anExtent y / self height.
    ^ self magnifiedBy:(rX min:rY)

    "
     ((Image fromFile:'bitmaps/garfield.gif') magnifiedPreservingRatioTo:100@100)

    in contrast to:

     ((Image fromFile:'bitmaps/garfield.gif') magnifiedTo:100@100)
    "
!

magnifiedTo:anExtent 
    "return a new image magnified to have the size specified by extent.
     This may distort the image if the arguments ratio is not the images ratio.
     See also #magnifiedPreservingRatioTo: and #magnifiedBy:"

    ^ self magnifiedBy:(anExtent / self extent)

    "
     ((Image fromFile:'bitmaps/garfield.gif') magnifiedTo:100@100)

    in contrast to:

     ((Image fromFile:'bitmaps/garfield.gif') magnifiedPreservingRatioTo:100@100)
    "
!

rotated:degrees
    "return a new image from the old one, by rotating the image
     degrees clockwise. 
     CAVEAT: Currently, only rotation by a multiple of 90 degrees is implemented."

    |w  "{Class: SmallInteger }"
     h  "{Class: SmallInteger }"
     c2 "{Class: SmallInteger }" 
     r2 "{Class: SmallInteger }"
     nW "{Class: SmallInteger }"
     nH "{Class: SmallInteger }"
     newImage newBits newBytesPerRow d|

    d := degrees.
    [d < 0] whileTrue:[d := d + 360].
    d >= 360 ifTrue:[d := d \\ 360].
    d := d truncated.
    d == 0 ifTrue:[^ self].
    ((d ~~ 90) and:[(d ~~ 270) and:[d ~~ 180]]) ifTrue:[
        ^ self hardRotated:d
    ].

    d == 180 ifTrue:[
        nW := width.
        nH := height.
    ] ifFalse:[
        nW := height.
        nH := width.
    ].

    newBytesPerRow := ((nW * self depth) + 7) // 8.
    newBits := ByteArray uninitializedNew:(newBytesPerRow * nH).

    newImage := self species new.
    newImage bits:newBits.
    newImage width:nW.
    newImage height:nH.
    newImage photometric:photometric.
    newImage samplesPerPixel:samplesPerPixel.
    newImage bitsPerSample:bitsPerSample.
    newImage colorMap:colorMap copy.

    w := width - 1.
    h := height - 1.

    d == 90 ifTrue:[
        0 to:h do:[:row |
            c2 := h-row.
            self valuesAtY:row from:0 to:w do:[:col :pixel |
                newImage atX:c2 y:col putValue:pixel.
            ]
"/            0 to:w do:[:col |
"/                newImage atX:c2 y:col putValue:(self valueAtX:col y:row).
"/            ]
        ]
    ].
    d == 180 ifTrue:[
        0 to:h do:[:row |
            r2 := h - row.
            self valuesAtY:row from:0 to:w do:[:col :pixel |
                newImage atX:(w-col) y:r2 putValue:pixel.
            ]
"/            0 to:w do:[:col |
"/                newImage atX:(w-col) y:r2 putValue:(self valueAtX:col y:row).
"/            ]
        ]
    ].
    d == 270 ifTrue:[
        0 to:h do:[:row |
            self valuesAtY:row from:0 to:w do:[:col :pixel |
                newImage atX:row y:(w-col) putValue:pixel.
            ]
"/            0 to:w do:[:col |
"/                newImage atX:row y:(w-col) putValue:(self valueAtX:col y:row).
"/            ]
        ]
    ].
    ^ newImage

    "
     |i|

     i := Image fromFile:'claus.gif'.
     i inspect.
     (i rotated:90) inspect.
     (i rotated:180) inspect.
     (i rotated:270) inspect.
    "

    "Modified: 7.6.1996 / 19:09:22 / cg"
!

withPixelFunctionApplied:pixelFunctionBlock
    "return a new image from the old one, by applying a pixel processor
     (read `Behond photography, by Gerard J. Holzmann;
           ISBM 0-13-074410-7)
     See blurred / oilPointed as examples ...)"

    |w  "{Class: SmallInteger }"
     h  "{Class: SmallInteger }"
     newImage newBits newBytesPerRow d|

    newBytesPerRow := ((width * self depth) + 7) // 8.
    newBits := ByteArray uninitializedNew:(newBytesPerRow * height).

    newImage := self species new.
    newImage bits:newBits.
    newImage width:width.
    newImage height:height.
    newImage photometric:photometric.
    newImage samplesPerPixel:samplesPerPixel.
    newImage bitsPerSample:bitsPerSample.
    newImage colorMap:colorMap copy.

    w := width - 1.
    h := height - 1.

    0 to:h do:[:y |
        0 to:w do:[:x |
            newImage atX:x y:y put:(pixelFunctionBlock
                                                value:self
                                                value:x
                                                value:y)
        ]
    ].
    ^ newImage

    "
     |i|

     i := Image fromFile:'claus.gif'.
     i inspect.
     (i withPixelFunctionApplied:[:oldImage :x :y |
                        ((x between:100 and:200) 
                        and:[y between:100 and:200]) ifTrue:[
                            oldImage atX:x y:y
                        ] ifFalse:[
                            Color black.
                        ]
                     ]) inspect.
    "

    "Modified: 17.5.1996 / 12:31:44 / cg"
! !

!Image methodsFor:'inspecting'!

inspectorClass
    "redefined to launch an ImageInspector
     (instead of the default InspectorView)."

    (width notNil and:[height notNil]) ifTrue:[
        ^ ImageInspectorView
    ].
    ^ super inspectorClass

    "Modified: 10.6.1996 / 18:23:55 / cg"
! !

!Image methodsFor:'instance release'!

disposed
    "some Image has been collected - nothing to do"
!

release
    "release device resources"

    device := nil.
    deviceForm := nil.
    monoDeviceForm := nil.
    fullColorDeviceForm := nil.
    Lobby unregister:self
!

restored
    "flush device specifics after a snapin or binary restore"

    self release
! !

!Image methodsFor:'obsolete'!

magnifyBy:scale
    "obsolete: has been renamed to magnifiedBy: for ST-80 compatibility
     and name consistency ..."

    self obsoleteMethodWarning.
    ^ self magnifiedBy:scale
! !

!Image methodsFor:'pixel copying'!

copyFrom:anImage x:srcX y:srcY toX:dstX y:dstY width:w height:h
    "replace a rectangulat area by pixels from another image.
     WARNING:
     This implementation is a slow fallback (the loop over the
     source pixels is very slow). If this method is used heavily, you
     may want to redefine it in concrete subclasses for the common case of
     of copying from an Image with the same depth & palette."

    |dX dY|

    dX := srcX-dstX.
    dY := srcY-dstY.
    ((photometric == anImage photometric)
     and:[self bitsPerPixel == anImage bitsPerPixel
     and:[colorMap = anImage colorMap]]) ifTrue:[
	"/ can loop over values
	anImage valuesFromX:srcX  y:srcY 
			toX:srcX+w-1 y:srcY+h-1  
			 do:[:x :y :pixelValue |
	    self atX:x-dX y:y-dY putValue:pixelValue.
	]
    ] ifFalse:[
	"/ must loop over colors
	anImage colorsFromX:srcX  y:srcY 
			toX:srcX+w-1 y:srcY+h-1  
			 do:[:x :y :clr |
	    self atX:x-dX y:y-dY put:clr.
	]
    ]

    "
     |i1 i8 i4|

     i8 := Image fromFile:'bitmaps/garfield.gif'.
     i8 inspect.
     i1 := Image fromFile:'bitmaps/SBrowser.xbm'.
     i1 inspect.

     i4 := Depth4Image fromImage:i8.
     i4 copyFrom:i1 x:0 y:0 toX:20 y:20 width:30 height:30.
     i4 inspect.
    "

    "Created: 20.9.1995 / 10:14:01 / claus"
    "Modified: 20.9.1995 / 10:25:31 / claus"
!

subImageIn:aRectangle
    "create and return a new image consisting of a subArea of myself"

    ^ self class fromSubImage:self in:aRectangle

    "
     |i|

     i := Image fromFile:'bitmaps/garfield.gif'.
     i inspect.
     (i subImageIn:(300@160 corner:340@200)) inspect
    "

    "Created: 20.9.1995 / 01:24:20 / claus"
! !

!Image methodsFor:'printing & storing'!

storeOn:aStream
    "append a printed representation of the receiver to aStream,
     from which a copy of it can be reconstructed."

    aStream nextPutAll:'(' , self class name , ' new)'.
    aStream nextPutAll:' width: '. width storeOn:aStream.
    aStream nextPutAll:'; height: '. height storeOn:aStream.
    aStream nextPutAll:'; photometric:('. photometric storeOn:aStream.
    aStream nextPutAll:'); bitsPerSample:('. bitsPerSample storeOn:aStream.
    aStream nextPutAll:'); samplesPerPixel:('. samplesPerPixel storeOn:aStream. 
    aStream nextPutAll:'); bits:('. bytes storeOn:aStream. aStream nextPutAll:') '.
    colorMap notNil ifTrue:[
        aStream nextPutAll:'; colorMap:('.
        colorMap storeOn:aStream.
        aStream nextPutAll:')'.
    ].
    aStream nextPutAll:'; yourself'

    "Modified: 23.4.1996 / 11:18:05 / cg"
! !

!Image methodsFor:'private'!

bestSupportedImageFormatFor:aDevice
    "scan through the image formats as supported by aDevice,
     and return the best to use when the receiver is to be represented
     on it. The best format is the one with the same number or more bits per
     pixel. Here, the smallest format found which can represent enough pixels is taken."

    |bestDeviceDepth bestDeviceBitsPerPixel bestInfo maxInfo myDepth maxDepth maxBitsPerPixel |

    myDepth := self bitsPerPixel.
    maxBitsPerPixel := 0.

    aDevice supportedImageFormats do:[:entry |
        |deviceImageDepth deviceImageBitsPerPixel|

        deviceImageDepth := entry at:#depth.
        deviceImageBitsPerPixel := entry at:#bitsPerPixel.

        deviceImageBitsPerPixel > maxBitsPerPixel ifTrue:[
            maxInfo := entry.
"/            maxBitsPerPixel := deviceImageBitsPerPixel.
"/            maxDepth := deviceImageDepth.
        ].

        deviceImageDepth >= myDepth ifTrue:[
            deviceImageDepth == myDepth ifTrue:[
                "/ take the better one ...
                (bestDeviceDepth isNil
                 or:[(bestDeviceBitsPerPixel ~~ bestDeviceDepth)
                    and:[deviceImageDepth == deviceImageBitsPerPixel]]) ifTrue:[
                    bestInfo := entry.
                    bestDeviceDepth := deviceImageDepth.
                    bestDeviceBitsPerPixel := deviceImageBitsPerPixel.
                ]
            ] ifFalse:[
                "/ take the next-larger depth
                (bestDeviceDepth isNil
                 or:[deviceImageBitsPerPixel < bestDeviceBitsPerPixel]) ifTrue:[
                    bestInfo := entry.
                    bestDeviceDepth := deviceImageDepth.
                    bestDeviceBitsPerPixel := deviceImageBitsPerPixel.
                ]
            ]    
        ].
    ].

    bestDeviceDepth isNil ifTrue:[
        maxBitsPerPixel == 0 ifTrue:[
            "/
            "/ oops - nothing appropriate
            "/
            maxInfo notNil ifTrue:[
                ^ maxInfo
            ].
            bestDeviceDepth := bestDeviceBitsPerPixel := aDevice depth.
            bestInfo := IdentityDictionary new.
            bestInfo at:#depth put:bestDeviceDepth.
            bestInfo at:#bitsPerPixel put:bestDeviceBitsPerPixel.
            bestInfo at:#padding put:32.
        ] ifFalse:[
            bestInfo := maxInfo.
        ]
    ].
    ^ bestInfo

    "Modified: 14.6.1996 / 14:46:40 / cg"
!

colormapFromImage:anImage
    "setup the receivers colormap from another image.
     Color precision may be lost, if conversion is from a higher depth
     image. This does not convert any pixel values; it is  non-public helper
     for fromImage:/fromSubImake:"

    samplesPerPixel == 3 ifTrue:[
	photometric := #rgb
    ] ifFalse:[
	photometric := anImage photometric.
	photometric == #palette ifTrue:[
	    colorMap := anImage colorMap copy.
	    "
	     must compress the colormap, if source image has higher depth
	     than myself. 
	    "
	    anImage bitsPerPixel > self bitsPerPixel ifTrue:[
		"
		 get used colors are extracted into our colorMap
		 (the at-put below will set the pixelValue according the
		 new colorIndex
		"
		colorMap := anImage usedColors asArray.
		colorMap size > (1 bitShift:self bitsPerPixel) ifTrue:[
		    'IMAGE: possibly too many colors in image' errorPrintNL
		]
	    ]
	]
    ].

    "Created: 20.9.1995 / 00:58:42 / claus"
!

greyByteMapForRange:range
    "return a collection to map from pixelValues to greyLevels
     in the range 0..range. 
     Range must be < 256 (for elements to fit into a ByteArray).
     The values are rounded towards the nearest pixel."

    |d n greyMap r|

    r := range.
    r == 256 ifTrue:[
        r := 255
    ].

    photometric == #palette ifTrue:[
        n := colorMap size.
        greyMap := ByteArray new:n.

        1 to:n do:[:i |
            greyMap at:i put:(r * (colorMap at:i) brightness) rounded
        ].
    ] ifFalse:[
        d := self bitsPerPixel.
        n := 1 bitShift:d.
        n >= 4096 ifTrue:[
            self error:'size not supported - too large'.
            ^ nil
        ].
        greyMap := ByteArray new:n.


        photometric == #rgb ifTrue:[
            1 to:n do:[:i |
                greyMap at:i put:(r * (self colorFromValue:i-1) brightness) rounded
            ].
        ] ifFalse:[
            1 to:n do:[:i |
                greyMap at:i put:(r / (n-1) * (i-1)) rounded
            ].
            photometric == #blackIs0 ifTrue:[
                "/ we are done
            ] ifFalse:[
                photometric == #whiteIs0 ifTrue:[
                    greyMap reverse
                ] ifFalse:[
                    self error:'invalid format'.
                    ^ nil
                ]
            ]
        ].
    ].

    ^ greyMap

    "
     Depth8Image new greyByteMapForRange:256

     Depth8Image new greyByteMapForRange:64
     Depth4Image new greyByteMapForRange:64

     Depth4Image new greyByteMapForRange:1
    "

    "Created: 8.6.1996 / 08:34:14 / cg"
    "Modified: 8.6.1996 / 14:52:32 / cg"
!

greyMapForRange:range
    "return a collection to map from pixelValues to greyLevels
     in the range 0..range. The brightness values are not rounded."

    |d r
     n "{Class: SmallInteger }"
     greyArray|

    d := self bitsPerPixel.
    n := 1 bitShift:d.
    n >= 4096 ifTrue:[
        self error:'size not supported - too large'.
        ^ nil
    ].

    greyArray := Array new:n.

    photometric == #palette ifTrue:[
        1 to:(colorMap size) do:[:i |
            greyArray at:i put:(range * (colorMap at:i) brightness)
        ].
    ] ifFalse:[
        photometric == #rgb ifTrue:[
            1 to:n do:[:i |
                greyArray at:i put:(range * (self colorFromValue:(i-1)) brightness)
            ]
        ] ifFalse:[
            r := range asFloat.
            1 to:n do:[:i |
                greyArray at:i put:(r / (n-1) * (i-1))
            ].
            photometric == #blackIs0 ifTrue:[
                "/ we are done
            ] ifFalse:[
                photometric == #whiteIs0 ifTrue:[
                    greyArray reverse
                ] ifFalse:[
                    self error:'invalid format'.
                    ^ nil
                ]
            ]
        ]
    ].
    ^ greyArray

    "
     Depth8Image new greyMapForRange:64
     Depth4Image new greyMapForRange:64

     Depth16Image new greyMapForRange:1
     Depth4Image new greyMapForRange:1
     Depth2Image new greyMapForRange:1
    "

    "Modified: 10.6.1996 / 10:37:40 / cg"
!

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

    "magnify a single pixel row - can only magnify by integer factors,
     can only magnify 1,2,4,8 and 24 bit-per-pixel images. But this is done fast."

    ^ self subclassResponsibility
!

makeDeviceGrayPixmapOn:aDevice depth:depth fromArray:bits
    "given the bits of a grey/color bitmap, 8-bit padded and
     pixels interpreted as greyValues, 0 is black,  
     create a device form for it"

    |f|

    f := Form width:width height:height depth:depth on:aDevice.
    f isNil ifTrue:[^ nil].

    f bits:bits.
    f initGC.

    (aDevice blackpixel ~~ 0) ifTrue:[
        "/ have to invert bits
        f function:#copyInverted
    ].
    aDevice drawBits:bits depth:depth
               width:width height:height
                   x:0 y:0
                into:(f id) 
                   x:0 y:0 
               width:width height:height 
                with:(f gcId).
    ^ f

    "Created: 10.6.1996 / 20:10:31 / cg"
!

makeDeviceMonochromeBitmapOn:aDevice fromArray:monoBits
    "given the bits of a monochrome bitmap, 8-bit padded and
     0-bits as black, create a device form for it"

    monoBits invert.
    ^ (Form width:width height:height fromArray:monoBits on:aDevice)
        colorMap:(Array with:Color black with:Color white).

    "Created: 10.6.1996 / 20:18:09 / cg"
    "Modified: 10.6.1996 / 20:31:24 / cg"
!

makeDevicePixmapOn:aDevice depth:depth fromArray:bits
    "given the bits of a grey/color bitmap, 8-bit padded and
     pixels interpreted as in the devices colormap, 
     create a device form for it"

    |f|

    f := Form width:width height:height depth:depth on:aDevice.
    f isNil ifTrue:[^ nil].

    f bits:bits.
    f initGC.

    aDevice drawBits:bits depth:depth
               width:width height:height
                   x:0 y:0
                into:(f id) 
                   x:0 y:0 
               width:width height:height 
                with:(f gcId).
    ^ f

    "Created: 10.6.1996 / 17:56:08 / cg"
    "Modified: 10.6.1996 / 20:11:27 / cg"
! !

!Image methodsFor:'queries'!

averageColor
    "return the average color of the image.
     This usually only makes sense for textures and patterns
     (i.e. to compute shadow & light colors for viewBackgrounds).
     Notice, that for the above purpose, it is usually ok to process 
     a subImage - i.e. use Image>>averageColorIn: on a smaller rectangle"

    ^ self averageColorIn:(0@0 corner:(width-1)@(height-1))
!

averageColorIn:aRectangle
    "return the images average color in an area.
     The implementation below is slow - so you may want to
     create tuned versions for DepthXImage if you plan to do
     heavy image processing ... 
     (also, creating tuned versions of the enumeration messages helps a lot)"

    |x0 "{ Class:SmallInteger }"
     y0 "{ Class:SmallInteger }"
     x1 "{ Class:SmallInteger }"
     y1 "{ Class:SmallInteger }"
     sumRed sumGreen sumBlue n|

    sumRed := sumGreen := sumBlue := 0.    
    y0 := aRectangle top.
    y1 := aRectangle bottom.
    x0 := aRectangle left.
    x1 := aRectangle right.

    self colorsFromX:x0 y:y0 toX:x1 y:y1 do:[:x :y :colorAtXY |
       sumRed := sumRed + colorAtXY red.
       sumGreen := sumGreen + colorAtXY green.
       sumBlue := sumBlue + colorAtXY blue.
    ].
    n := (x1 - x0 + 1) * (y1 - y0 + 1).    
    ^ Color red:(sumRed / n) green:(sumGreen / n) blue:(sumBlue / n)
!

bitsPerPixel
    "return the number of bits per pixel"

    ^ (bitsPerSample inject:0 into:[:sum :i | sum + i])
!

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

    ^  width * (self bitsPerPixel).
!

blueBitsOf:pixel
    "if the receiver is an rgb-image:
     return the blue bits of a pixelValue.
     This has to be redefined by subclasses."

    |blueBits|

    samplesPerPixel >= 3 ifTrue:[
        "/ assume that the red bits are the leftMost bits

        blueBits := bitsPerSample at:3.
        blueBits == 0 ifTrue:[^ 0].

        ^ pixel bitAnd:(1 bitShift:blueBits)-1
    ].

    self subclassResponsibility

    "Created: 8.6.1996 / 09:44:21 / cg"
    "Modified: 10.6.1996 / 14:59:44 / cg"
!

blueComponentOf:pixel
    "if the receiver is an rgb-image:
     return the blue component (0 .. 100) of a pixelValue.
     This has to be redefined by subclasses."

    |blueBits  "{ Class: SmallInteger }"
     s         "{ Class: SmallInteger }"|

    samplesPerPixel >= 3 ifTrue:[
        "/ assume that the red bits are the leftMost bits

        blueBits := bitsPerSample at:3.
        blueBits == 0 ifTrue:[^ 0].

        s := (1 bitShift:blueBits) - 1.

        ^ 100.0 / s * (pixel bitAnd:(1 bitShift:blueBits)-1)
    ].

    self subclassResponsibility

    "Created: 8.6.1996 / 08:45:22 / cg"
    "Modified: 10.6.1996 / 14:55:39 / cg"
!

bounds
    "return my bounds (added to make images usable as VisualComponents)"

    ^ Rectangle left:0 top:0 width:width height:height

    "Created: 13.5.1996 / 10:27:06 / cg"
!

brightness
    "return the (average) brightness of the image.
     This usually only makes sense for textures and patterns
     (i.e. to compute shadow & light colors for viewBackgrounds).
     Notice, that for the above purpose, only a subimage is inspected here"

    ^ (self averageColorIn:(0@0 corner:7@7)) brightness

    "Modified: 8.6.1996 / 08:46:46 / cg"
!

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

    |bitsPerRow bytesPerRow|

    bitsPerRow := width * (self bitsPerPixel).
    bytesPerRow := bitsPerRow // 8.
    ((bitsPerRow \\ 8) ~~ 0) ifTrue:[
	bytesPerRow := bytesPerRow + 1
    ].
    ^ bytesPerRow
!

colorFromValue:pixelValue
    "given a pixel value, return the corresponding color.
     Pixel values start with 0."

    |maxPixel r g b|

    photometric == #blackIs0 ifTrue:[
        maxPixel := (1 bitShift:self bitsPerPixel) - 1.
        ^ Color gray:(pixelValue * (100 / maxPixel)).
    ].

    photometric == #whiteIs0 ifTrue:[
        maxPixel := (1 bitShift:self bitsPerPixel) - 1.
        ^ Color gray:100 - (pixelValue * (100 / maxPixel)).
    ].

    photometric == #palette ifTrue:[
        pixelValue >= colorMap size ifTrue:[
            ^ Color black
        ].
        ^ colorMap at:(pixelValue + 1)
    ].

    photometric == #rgb ifTrue:[
        r := self redComponentOf:pixelValue.
        g := self greenComponentOf:pixelValue.
        b := self blueComponentOf:pixelValue.
        ^ Color red:r green:g blue:b
    ].

    self error:'invalid photometric'

    "Created: 8.6.1996 / 08:46:18 / cg"
    "Modified: 12.6.1996 / 17:00:38 / cg"
!

greenBitsOf:pixel
    "if the receiver is an rgb-image:
     return the green bits of a pixelValue.
     This has to be redefined by subclasses."

    |blueBits greenBits|

    samplesPerPixel >= 3 ifTrue:[
        "/ assume that the red bits are the leftMost bits

        greenBits := bitsPerSample at:2.
        greenBits == 0 ifTrue:[^ 0].
        blueBits := bitsPerSample at:3.

        ^ (pixel bitShift:blueBits negated) bitAnd:(1 bitShift:greenBits)-1
    ].

    self subclassResponsibility

    "Created: 8.6.1996 / 09:44:37 / cg"
    "Modified: 10.6.1996 / 14:59:35 / cg"
!

greenComponentOf:pixel
    "if the receiver is an rgb-image:
     return the green component (0..100)  of a pixelValue.
     This has to be redefined by subclasses."

    |greenBits "{ Class: SmallInteger }"
     blueBits  "{ Class: SmallInteger }"
     s         "{ Class: SmallInteger }"|

    samplesPerPixel >= 3 ifTrue:[
        "/ assume that the red bits are the leftMost bits

        greenBits := bitsPerSample at:2.
        greenBits == 0 ifTrue:[^ 0].
        blueBits := bitsPerSample at:3.

        s := (1 bitShift:greenBits) - 1.

        ^ 100.0 / s * ((pixel bitShift:blueBits negated) bitAnd:(1 bitShift:greenBits)-1)
    ].

    self subclassResponsibility

    "Created: 8.6.1996 / 08:45:34 / cg"
    "Modified: 10.6.1996 / 14:55:24 / cg"
!

heightOn:aGC
    "return my height, if displayed on aGC;
     since my height is independent of the device (the number of pixels),
     return the pixel-height"

    ^ height

    "Created: 12.5.1996 / 21:35:06 / cg"
    "Modified: 13.5.1996 / 10:26:36 / cg"
!

isImage
    "return true, if the receiver is some kind of image;
     true is returned here - the method is redefined from Object."

    ^ true
!

isImageOrForm
    "return true, if the receiver is some kind of image or form;
     true is returned here - the method is redefined from Object."

    ^ true
!

redBitsOf:pixel
    "if the receiver is an rgb-image:
     return the red component of a pixelValue.
     This has to be redefined by subclasses."

    |redBits greenBits blueBits|

    samplesPerPixel >= 3 ifTrue:[
        "/ assume that the red bits are the leftMost bits

        redBits := bitsPerSample at:1.
        redBits == 0 ifTrue:[^ 0].
        greenBits := bitsPerSample at:2.
        blueBits := bitsPerSample at:3.

        ^ (pixel bitShift:(greenBits + blueBits) negated)
           bitAnd:(1 bitShift:redBits)-1
    ].

    self subclassResponsibility

    "Created: 8.6.1996 / 09:44:51 / cg"
    "Modified: 10.6.1996 / 14:59:05 / cg"
!

redComponentOf:pixel
    "if the receiver is an rgb-image:
     return the red component (0..100) of a pixelValue.
     This has to be redefined by subclasses."

    |redBits   "{ Class: SmallInteger }"
     greenBits "{ Class: SmallInteger }"
     blueBits  "{ Class: SmallInteger }"
     s         "{ Class: SmallInteger }"|

    samplesPerPixel >= 3 ifTrue:[
        "/ assume that the red bits are the leftMost bits

        redBits := bitsPerSample at:1.
        redBits == 0 ifTrue:[^ 0].

        greenBits := bitsPerSample at:2.
        blueBits := bitsPerSample at:3.

        s := (1 bitShift:redBits) - 1.

        ^ 100.0 / s * 
          ((pixel bitShift:(greenBits + blueBits) negated)
           bitAnd:(1 bitShift:redBits)-1)
    ].

    self subclassResponsibility

    "Created: 8.6.1996 / 08:45:30 / cg"
    "Modified: 14.6.1996 / 17:34:00 / cg"
!

usedColors
    "return a collection of colors used in the receiver."

    |usedValues max|

    photometric == #rgb ifTrue:[
        "/ too many to be returned here (think of the mass of
        "/ data to be returned by a 24bit image ... ;-)

        self error:'query not allowed for this image'.
        ^ nil
    ].

    usedValues := self usedValues asArray.
    photometric == #palette ifTrue:[
        ^ usedValues collect:[:val | (colorMap at:val+1)]
    ].

    "/ (photometric == #blackIs0 or:[photometric == #whiteIs0])

    max := (1 bitShift:self depth) - 1.
    ^ usedValues collect:[:val | (Color gray:(100 * val / max ))]

    "
     (Image fromFile:'bitmaps/garfield.gif') usedColors
     (Image fromFile:'bitmaps/SBrowser.xbm') usedColors
     (Image fromFile:'ttt.tiff') usedColors  
    "

    "Modified: 8.6.1996 / 09:04:56 / cg"
!

usedValues
    "return a collection of color values used in the receiver.
     Notice, that the interpretation of the pixels depends on the photometric
     of the image.
     This is a general and therefore slow implementation; subclasses
     may want to redefine this method for more performance."

    |set|

    set := IdentitySet new.
    self valuesFromX:0 y:0 toX:(self width-1) y:(self height-1) do:[:x :y :pixel |
	set add:pixel 
    ].
    ^ set

    "
     (Image fromFile:'bitmaps/garfield.gif') usedValues
     (Image fromFile:'bitmaps/SBrowser.xbm') usedValues
     (Image fromFile:'ttt.tiff') usedValues  
    "
!

valueFromColor:color
    "given a color, return the corresponding pixel value.
     Non-representable colors return nil."

    |pixel maxPixel redBits greenBits blueBits r g b|

    photometric == #whiteIs0 ifTrue:[
        maxPixel := (1 bitShift:self bitsPerPixel) - 1.
        ^ maxPixel - (color brightness * maxPixel) rounded.
    ].

    photometric == #blackIs0 ifTrue:[
        maxPixel := (1 bitShift:self bitsPerPixel) - 1.
        ^ (color brightness * maxPixel) rounded.
    ].

    photometric == #palette ifTrue:[
        pixel := colorMap indexOf:color.
        pixel == 0 ifTrue:[
            "
             the color to be stored is not in the images colormap
            "
            ^ nil
        ].
        ^ pixel - 1
    ].

    photometric == #rgb ifTrue:[
        samplesPerPixel >= 3 ifTrue:[
            redBits := bitsPerSample at:1.
            greenBits := bitsPerSample at:2.
            blueBits := bitsPerSample at:3.
        
            "/ map r/g/b to 0..255
            r := (color red / 100.0 * ((1 bitShift:redBits)-1)) rounded.
            g := (color green / 100.0 * ((1 bitShift:greenBits)-1)) rounded.
            b := (color blue / 100.0 * ((1 bitShift:blueBits)-1)) rounded.
            pixel := (((r bitShift:greenBits) + g) bitShift:blueBits) + b.
            ^ pixel
        ]
    ].

    self error:'format not supported'.
    ^ nil

    "Modified: 15.6.1996 / 09:38:09 / cg"
!

widthOn:aGC
    "return my width, if displayed on aGC;
     since my width is independent of the device (the number of pixels),
     return the pixel-width"

    ^ width

    "Created: 12.5.1996 / 21:34:59 / cg"
    "Modified: 13.5.1996 / 10:26:42 / cg"
! !

!Image methodsFor:'saving on file'!

saveOn:aFileName
    "save the image in a aFileName. The suffix of the filename
     controls the format. Currently, not all formats may be supported
     (see ImageReader subclasses implementing save:onFile:)"

    "
     from the extension, get the imageReader class
     (which should know how to write images as well)
    "
    FileFormats associationsDo:[:a |
	(aFileName endsWith:(a key)) ifTrue:[
	    ^ (a value) save:self onFile:aFileName
	]
    ].

    "
     no known extension - could ask user for the format here.
     currently default to tiff format.
    "
    'IMAGE: unknown extension - cannot figure out format - using tiff' errorPrintNL.
    ^ self saveOn:aFileName using:TIFFReader
!

saveOn:aFileName using:readerClass
    "save the receiver using the representation class"

    readerClass save:self onFile:aFileName

    "
     anImage saveOn:'myImage' using:TIFFReader
     anImage saveOn:'myImage' using:XBMReader
    "
! !

!Image methodsFor:'screen capture'!

fromScreen:aRectangle
    "read an image from the display screen"

    ^ self fromScreen:aRectangle on:Screen current
!

fromScreen:aRectangle on:aDevice
    "read an image from aDevices display screen.
     Since I have no other displays, only the MonoChrome, StaticGrey 
     and PseudoColor cases have been tested ... 
     (especially True- and DirectColor may be wrong).
     Late note: 24bit rgb now also works."

    |depth visType 
     x        "{ Class: SmallInteger }"
     y        "{ Class: SmallInteger }"
     w        "{ Class: SmallInteger }"
     h        "{ Class: SmallInteger }"
     dstIndex "{ Class: SmallInteger }" 
     srcIndex "{ Class: SmallInteger }" 
     srcRow   "{ Class: SmallInteger }"
     dstRow   "{ Class: SmallInteger }"
     inData tmpData usedPixels mapSize 
     map bitsPerPixel bytesPerLine byteOrder spaceBitsPerPixel
     info bitsPerPixelIn bytesPerLineIn curs cid rootView
     maskR "{ Class: SmallInteger }"
     maskG "{ Class: SmallInteger }"
     maskB "{ Class: SmallInteger }"
     shR "{ Class: SmallInteger }"
     shG "{ Class: SmallInteger }"
     shB "{ Class: SmallInteger }"
     shR2 "{ Class: SmallInteger }"
     shG2 "{ Class: SmallInteger }"
     shB2 "{ Class: SmallInteger }"
     r "{ Class: SmallInteger }"
     g "{ Class: SmallInteger }"
     b "{ Class: SmallInteger }"
     word|

    curs := Cursor sourceForm:(Form fromFile:'Camera.xbm')
                     maskForm:(Form fromFile:'Camera_m.xbm')
                      hotSpot:16@16.
    curs notNil ifTrue:[
        cid := (curs on:aDevice) id
    ].

    "
     get some attributes of the display device
    "
    visType := aDevice visualType.
    depth := aDevice depth.

    "/ kludge for 15bit XFree server
    depth == 15 ifTrue:[
        depth := 16
    ].

    (visType == #StaticGray) ifTrue:[
        (aDevice blackpixel == 0) ifTrue:[
            photometric := #blackIs0
        ] ifFalse:[
            photometric := #whiteIs0
        ].
        samplesPerPixel := 1.
        bitsPerPixel := depth.
        bitsPerSample := Array with:bitsPerPixel.
    ] ifFalse:[
        ((visType == #PseudoColor) or:[(visType == #StaticColor) or:[visType == #GrayScale]]) ifTrue:[
            photometric := #palette.
            samplesPerPixel := 1.
            bitsPerPixel := depth.
            bitsPerSample := Array with:bitsPerPixel.
        ] ifFalse:[
            ((visType == #TrueColor) or:[visType == #DirectColor]) ifTrue:[
                photometric := #rgb.
                samplesPerPixel := 3.
"/                bitsPerPixel := depth.
"/                bitsPerSample := Array with:aDevice bitsRed
"/                                       with:aDevice bitsGreen
"/                                       with:aDevice bitsBlue
                bitsPerPixel := 24.
                bitsPerSample := #(8 8 8).
            ] ifFalse:[
                self error:'screen visual not supported'.
                ^ nil
            ]
        ]
    ].

    "
     dont know yet, how the display pads; assume worst case, 
     offering enough space for 32 bit padding
    "
    w := width := aRectangle width.
    h := height := aRectangle height.
    x := aRectangle left.
    y := aRectangle top.

    "
     a kludge: we dont know in advance how much we are going to need
     (its too late when info is present ...)
    "
    spaceBitsPerPixel := bitsPerPixel.
    (bitsPerPixel > 8) ifTrue:[
        spaceBitsPerPixel := 16.
        (bitsPerPixel > 16) ifTrue:[
            spaceBitsPerPixel := 32.
            (bitsPerPixel > 32) ifTrue:[
                spaceBitsPerPixel := bitsPerPixel.
            ]
        ]
    ].

    bytesPerLine := (w * spaceBitsPerPixel + 31) // 32 * 4.
    inData := ByteArray uninitializedNew:(bytesPerLine * height).

    "
     actually have to grabServer ... but thats not yet available
    "
    rootView := aDevice rootView.
    aDevice setActivePointerGrab:rootView.
    aDevice grabPointerIn:rootView id
               withCursor:cid pointerMode:#async keyboardMode:#sync confineTo:nil.

    "
     get the pixels
    "
    info := aDevice getBitsFrom:rootView id x:x y:y width:w height:h into:inData. 

    "
     check if byteorder is what I like (msbFirst)
    "
    byteOrder := info at:#byteOrder.
    bitsPerPixelIn := info at:#bitsPerPixel.
    byteOrder ~~ #msbFirst ifTrue:[
        bitsPerPixelIn == 16 ifTrue:[
            "/ must swap bytes
            inData swapBytes
        ] ifFalse:[
            bitsPerPixelIn == 32 ifTrue:[
                "/ must swap longs
                inData swapLongs
            ]
        ]
    ].

    "
     check, if the devices padding is different ..
     or if the bitsPerPixels are different
    "
    bytesPerLineIn := (info at:#bytesPerLine).                    "what I got"
    bytesPerLine := (w * bitsPerPixel + 7) // 8.                  "what I want"

    ((bytesPerLine ~~ bytesPerLineIn) 
    or:[bitsPerPixelIn ~~ bitsPerPixel]) ifTrue:[
        tmpData := inData.
        inData := ByteArray uninitializedNew:(bytesPerLine * height).

        srcRow := 1.
        dstRow := 1.

        bitsPerPixelIn ~~ bitsPerPixel ifTrue:[
            "/ for now, only 32 -> 24 is supported

            maskR := (1 bitShift:aDevice bitsRed) - 1.
            maskG := (1 bitShift:aDevice bitsGreen) - 1.
            maskB := (1 bitShift:aDevice bitsBlue) - 1.
            shR := aDevice shiftRed negated.
            shG := aDevice shiftGreen negated.
            shB := aDevice shiftBlue negated.
            shR2 := (8 - aDevice bitsRed).
            shG2 := (8 - aDevice bitsGreen).
            shB2 := (8 - aDevice bitsBlue).

            ((bitsPerPixelIn == 32) and:[bitsPerPixel == 24]) ifTrue:[
                "/ 'reformatting 32->24...' printNL.
                1 to:h do:[:hi |
                    srcIndex := srcRow.
                    dstIndex := dstRow.

                    1 to:w do:[:wi |
                        word := tmpData doubleWordAt:srcIndex MSB:true.
                        r := (word bitShift:shR) bitAnd:maskR.
                        g := (word bitShift:shG) bitAnd:maskG.
                        b := (word bitShift:shB) bitAnd:maskB.

                        inData at:dstIndex   put:r.
                        inData at:dstIndex+1 put:g.
                        inData at:dstIndex+2 put:b.
                        srcIndex := srcIndex + 4.
                        dstIndex := dstIndex + 3.
                    ].
                    dstRow := dstRow + bytesPerLine.
                    srcRow := srcRow + bytesPerLineIn
                ]
            ] ifFalse:[
                ((bitsPerPixelIn == 16) and:[bitsPerPixel == 24]) ifTrue:[
                    "/ 'reformatting 16->24...' printNL.
                    1 to:h do:[:hi |
                        srcIndex := srcRow.
                        dstIndex := dstRow.

                        1 to:w do:[:wi |
                            word := tmpData wordAt:srcIndex MSB:true.
                            r := (word bitShift:shR) bitAnd:maskR.
                            g := (word bitShift:shG) bitAnd:maskG.
                            b := (word bitShift:shB) bitAnd:maskB.

                            inData at:dstIndex   put:(r bitShift:shR2).
                            inData at:dstIndex+1 put:(g bitShift:shG2).
                            inData at:dstIndex+2 put:(b bitShift:shB2).
                            srcIndex := srcIndex + 2.
                            dstIndex := dstIndex + 3.
                        ].
                        dstRow := dstRow + bytesPerLine.
                        srcRow := srcRow + bytesPerLineIn
                    ]
                ] ifFalse:[
                    ('IMAGE: unsupported depth combination: ' , bitsPerPixelIn printString , ' -> ' ,
                                                        bitsPerPixel printString) errorPrintNL.
                    ^ nil
                ]
            ].
        ] ifFalse:[
            "
             repad in the buffer
            "
            1 to:h do:[:hi |
                inData replaceFrom:dstRow to:(dstRow + bytesPerLine - 1)
                              with:tmpData startingAt:srcRow.
                dstRow := dstRow + bytesPerLine.
                srcRow := srcRow + bytesPerLineIn
            ]
        ]
    ] ifFalse:[
        (bytesPerLine * height) ~~ inData size ifTrue:[
            tmpData := inData.
            inData := ByteArray uninitializedNew:(bytesPerLine * height).
            inData replaceFrom:1 to:bytesPerLine * height with:tmpData startingAt:1
        ]
    ].
    bytes := inData.

    "info printNL."

    ((visType == #StaticGray) 
    or:[visType == #TrueColor
    or:[visType == #DirectColor]]) ifTrue:[
        "
         were done, the pixel values are the rgb/grey values
        "
    ] ifFalse:[
        "
         what we have now are the color numbers - still need the r/g/b values.
         find out, which colors are in the picture
        "
        usedPixels := inData usedValues.
        mapSize := usedPixels max + 1.

        "get the palette"
        map := Array new:mapSize.
        usedPixels do:[:colorIndex |
            |i|

            i := colorIndex + 1.
            aDevice getRGBFrom:colorIndex into:[:r :g :b |
                map at:i put:(Color red:r green:g blue:b)
            ]
        ].
        colorMap := map.
    ].

    aDevice ungrabPointer.

    "
     (Image new) fromScreen:((0 @ 0) corner:(100 @ 100)) on:Display
     (Image new) fromScreen:((0 @ 0) corner:(500 @ 500)) on:Display
    "

    "Modified: 7.3.1996 / 19:17:33 / cg"
! !

!Image class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.102 1996-06-17 15:32:27 cg Exp $'
! !
Image initialize!