.
"
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 comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libview/Image.st,v 1.42 1995-10-23 16:59:09 cg Exp $
'!
!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.
"
!
version
"
$Header: /cvs/stx/stx/libview/Image.st,v 1.42 1995-10-23 16:59:09 cg Exp $
"
!
documentation
"
this class provides (some time in the future) representation
for all kinds of images (monochrome, greyscale and color)
and will finally replace Form - its still under construction.
An Image keeps all info in a device independent way, but may get
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 an image the 'on:aDevice' message, which will create
a (possibly dithered) form, representing the image using the currently
available colors.
Sometimes, an explicit monochrome representation is needed
(X servers take monochrome icons only), this can be created by sending
'anImage monochromeOn:aDevice'.
Also, it is planned to generate another hi-color resolution version,
which needs its own colormap to be installed and allows use of all
256 colors on an 8bit display (not currently implemented).
To convert pictures from/to external file-formats, readers are used
which have the file-format knowledge (see TIFFReader, GIFReader etc.).
The algorithms in here (especially dithering & color allocation) are
experimental and far from being perfect (some are very slow).
Much more work is needed and will be done in the near future ...
Dithering is done as:
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
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
Image initialize.
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> an Array of 3 arrays containing red,
green and blue values (0..255 biased)
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
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)
"
! !
!Image class methodsFor:'queries'!
imageDepth
self shouldNotImplement
!
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 == 16 ifTrue:[^ Depth16Image].
depth == 24 ifTrue:[^ Depth24Image].
^ self
! !
!Image class methodsFor:'misc'!
dither:aSymbol
"define how to dither - #pattern, #error or none;
error diffusion dithering is currently not implemented,
pattern dither is currently very slow."
DitherAlgorithm := aSymbol
"Image dither:#pattern"
"Image dither:#error"
"Image dither:nil"
!
numberOfDitherColors:n
"define how many colors (i.e. patterns) to use when
doing a pattern dither"
NumberOfDitherColors := n
! !
!Image class methodsFor:'initialization'!
initialize
"initialize class constants"
"setup tracker of known pictures"
Lobby isNil ifTrue:[
Lobby := Registry new.
ObjectMemory addDependent:self.
].
"define algorithm to use for dithering - currently only nil or #pattern supported"
DitherAlgorithm := #pattern. "will be changed to error as soon as implemented"
(Display notNil and:[Display hasGreyscales]) 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 := true
!
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
"
!
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 unassign all pictures from their device"
Lobby do:[:anImage |
anImage restored
]
!
update:something
"flush all device specific stuff when restarted from a snapshot"
(something == #restarted) ifTrue:[
self flushDeviceImages
]
! !
!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))
!
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"
!
fromScreenArea
"return an image of a part of the screen;
let user specify screen area."
^ self fromScreen:(Rectangle fromUser)
"Image fromScreenArea"
!
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 img|
depth := aDisplay depth.
img := (self implementorForDepth: depth) new.
^ img fromScreen:aRectangle on:aDisplay
"Image fromScreen:(0@0 corner:100@100)"
!
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 device.
org := dev translatePoint:(0@0)
from:(aView id)
to:dev rootWindowId "(DisplayRootView on:dev) id".
^ self fromScreen:(org extent:aView extent) on:dev
"
Image fromView:(Launcher allInstances first topView)
Image fromView:(SystemBrowser allInstances first topView)
"
! !
!Image class methodsFor:'instance creation'!
new
"create a new image. Redefined to set the photometric to
greyScale with black being 0 as default."
^ super new photometric:#blackIs0
!
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') infoPrintNL.
^ 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: ' errorPrint. aFileName errorPrintNL.
^ 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'
"
!
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."
^ self new fromSubImage:anImage in:aRectangle.
"
|i1 i8|
i1 := Image fromFile:'bitmaps/garfield.gif'.
i8 := Depth8Image fromSubImage:i1 in:(0@0 corner:20@20).
i8 inspect
"
"Created: 20.9.1995 / 01:05:43 / claus"
!
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 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|
cls := self.
cls == Image ifTrue:[
cls := self implementorForDepth:1.
d := 1.
] ifFalse:[
d := cls imageDepth
].
^ cls new width:w height:h depth:d fromArray:anArray
"
Image width:8
height:8
fromArray:#[2r11001100
2r00110011
2r11001100
2r00110011
2r11001100
2r00110011
2r11001100
2r00110011].
"
!
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:#[4r0001 4r0001
4r0011 4r0011
4r1100 4r1100
4r0011 4r0011
4r1100 4r1100
4r0011 4r0011
4r1100 4r1100
4r0011 4r0011].
"
!
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:[
newBits := pixelData
].
img bits:newBits.
^ img
!
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 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 bits:bits
"ST-80 compatibility; assume 32-bit padding"
^ self extent:ext depth:d bits:bits pad:32
!
extent:ext fromArray:bits offset:offset
"ST-80 compatibility"
^ self width:ext x height:ext y fromArray:bits
! !
!Image methodsFor:'copying'!
postCopy
bytes := bytes copy.
colorMap := colorMap deepCopy.
device := deviceForm := monoDeviceForm := fullColorDeviceForm := nil
! !
!Image methodsFor:'pixel copying'!
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"
!
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"
! !
!Image methodsFor:'instance release'!
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
!
disposed
"some Image has been collected - nothing to do"
! !
!Image methodsFor:'inspecting'!
inspectorClass
"redefined to launch an ImageInspector
(instead of the default InspectorView)."
^ ImageInspectorView
! !
!Image methodsFor:'displaying'!
displayOn:aGC at:aPoint
"draw in aGC.
Smalltalk-80 compatibility"
aGC displayForm:self x:aPoint x y:aPoint y.
! !
!Image methodsFor:'accessing'!
device
"return the device, the receiver is associated with.
Return nil, if the image is unassigned."
^ device
!
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
!
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
!
width
"return the width of the image"
^ width
!
width:aNumber
"set the width of the image"
width := aNumber
!
height
"return the height of the image"
^ height
!
height:aNumber
"set the height of the image"
height := aNumber
!
width:w height:h
"set the width and height of the image"
width := w.
height := h
!
extent
"return the images extent"
^ width@height
!
extent:anExtent
"set the images extent"
width := anExtent x.
height := anExtent y
!
samplesPerPixel
"return the number of samples per pixel in the image.
The return value is an array of bits-per-plane."
^ samplesPerPixel
!
samplesPerPixel:aNumber
"set the array of samples per pixel"
samplesPerPixel := aNumber
!
depth:d
"set the depth of the image"
d == 24 ifTrue:[
samplesPerPixel := 3.
bitsPerSample := #(8 8 8)
] ifFalse:[
samplesPerPixel := 1.
bitsPerSample := Array with:d
]
!
depth
"return the depth of the image"
^ self bitsPerPixel
!
width:w height:h depth:d
"set the width, height and depth of the image"
width := w.
height := h.
self depth:d.
!
width:w height:h depth:d fromArray:bits
"set the width, height, depth and pixels of the image"
width := w.
height := h.
self depth:d.
bytes := bits
!
bitsPerSample
"return the number of bits per sample.
The return value is an array of bits-per-plane."
^ bitsPerSample
!
bitsPerSample:aNumber
bitsPerSample := aNumber
!
data
"for backward compatibility - will vanish"
^ bytes
!
data:aByteArray
"for backward compatibility - will vanish"
bytes := aByteArray
!
bits:aByteArray
"set the raw data"
bytes := aByteArray
!
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
!
photometric
"return the photometric, a symbol such as #palette, #rgb etc."
^ photometric
!
photometric:aSymbol
"set the photometric"
photometric := aSymbol
!
colorMap:anArrayOfArrays
colorMap := anArrayOfArrays.
photometric isNil ifTrue:[photometric := #palette].
deviceForm notNil ifTrue:[self release]
"Modified: 31.8.1995 / 03:05:59 / claus"
!
colorMap
"return the colormap"
^ colorMap
!
palette
"return the colormap; ST-80 compatibility"
^ colorMap
!
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
!
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 r g b|
pixel := self valueAtX:x y:y.
photometric == #blackIs0 ifTrue:[
maxPixel := (1 bitShift:self bitsPerPixel) - 1.
^ Color grey:(pixel * (100 / maxPixel)).
].
photometric == #whiteIs0 ifTrue:[
maxPixel := (1 bitShift:self bitsPerPixel) - 1.
^ Color grey:100 - (pixel * (100 / maxPixel)).
].
photometric == #palette ifTrue:[
^ colorMap at:(pixel + 1)
].
photometric == #rgb ifTrue:[
r := (pixel bitShift:16) bitAnd:16rFF.
g := (pixel bitShift:8) bitAnd:16rFF.
b := pixel bitAnd:16rFF.
^ Color red:r / 255 * 100
green:g / 255 * 100
blue:b / 255 * 100
].
self error:'invalid photometric'
!
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
!
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'
].
pixel := pixel - 1
]
].
self atX:x y:y putValue:pixel.
!
atPoint:aPoint
"ST-80 compatibility: return the pixelValue at:aPoint."
^ self valueAtX:aPoint x y:aPoint y
!
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
!
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
! !
!Image methodsFor:'enumerating'!
valueAtY: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:(self valueAtX:xRun y:y)
]
!
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 valueAtY:yRun from:xStart to:xEnd do:[:xRun :pixel |
aBlock value:xRun value:yRun value:pixel
]
]
!
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)."
|xStart "{Class: SmallInteger }"
xEnd "{Class: SmallInteger }"|
xStart := x1.
xEnd := x2.
xStart to:xEnd do:[:xRun |
aBlock value:(self atX:xRun y:y)
]
!
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 atY:yRun from:xStart to:xEnd do:[:xRun :color |
aBlock value:xRun value:yRun value:color
]
]
! !
!Image methodsFor:'queries'!
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
!
brightness
"return the 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
!
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).
!
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
!
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
"
!
usedColors
"return a collection of colors used in the receiver."
|usedValues max|
usedValues := self usedValues asArray.
photometric ~~ #palette ifTrue:[
max := (1 bitShift:self depth) - 1.
^ usedValues collect:[:val | (Color grey:(100 * val / max ))]
].
^ usedValues collect:[:val | (colorMap at:val+1)]
"
(Image fromFile:'bitmaps/garfield.gif') usedColors
(Image fromFile:'bitmaps/SBrowser.xbm') usedColors
(Image fromFile:'ttt.tiff') usedColors
"
! !
!Image methodsFor:'printing & storing'!
storeOn:aStream
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'
! !
!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)"
|depth visType
x "{ Class: SmallInteger }"
y "{ Class: SmallInteger }"
w "{ Class: SmallInteger }"
h "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
srcIndex "{ Class: SmallInteger }"
inData tmpData usedPixels mapSize
map bitsPerPixel bytesPerLine
info bytesPerLineIn curs cid rootView|
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.
(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 := 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.
bytesPerLine := (w * bitsPerPixel + 31) // 32 * 4.
inData := ByteArray uninitializedNew:(bytesPerLine * height).
"
actually have to grabServer ... but thats not yet available
"
rootView := DisplayRootView on:aDevice.
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 the devices padding is different ..
"
bytesPerLineIn := (info at:3). "what I got"
bytesPerLine := (w * bitsPerPixel + 7) // 8. "what I want"
(bytesPerLine ~~ bytesPerLineIn) ifTrue:[
tmpData := inData.
inData := ByteArray uninitializedNew:(bytesPerLine * height).
srcIndex := 1.
dstIndex := 1.
"
repad in the buffer
"
1 to:h do:[:hi |
inData replaceFrom:dstIndex to:(dstIndex + bytesPerLine - 1)
with:tmpData startingAt:srcIndex.
dstIndex := dstIndex + bytesPerLine.
srcIndex := srcIndex + 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]) 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
"
! !
!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:'converting'!
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
!
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.
!
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].
(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
!
asMonochromeFormOn:aDevice
"get a monochrome device form"
|form|
((aDevice == device) and:[monoDeviceForm notNil]) ifTrue:[^ monoDeviceForm].
(photometric == #palette) ifTrue:[
form := self paletteImageAsMonoFormOn:aDevice
] ifFalse:[
(photometric == #rgb) ifTrue:[
form := self rgbImageAsMonoFormOn:aDevice
] ifFalse:[
form := self greyImageAsMonoFormOn:aDevice
]
].
(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
!
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 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"
!
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.
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 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"
!
fromForm:aForm
"setup 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)
"
]
].
!
asCachedImage
"for ST-80 compatibility"
^ self on:Screen current
! !
!Image methodsFor:'converting rgb images'!
rgbImageAsFormOn:aDevice
"convert am rgb image to a device-form on aDevice.
Return the device-form."
|visual|
visual := aDevice visualType.
(visual == #StaticGray) ifTrue:[
^ self rgbImageAsGreyFormOn:aDevice
].
(visual == #TrueColor) ifTrue:[
^ self rgbImageAsTrueColorFormOn:aDevice
].
^ self rgbImageAsPseudoFormOn:aDevice
!
rgbImageAsGreyFormOn:aDevice
"convert an rgb image to a grey device-form on aDevice
(for greyscale displays)"
|deviceDepth|
deviceDepth := aDevice depth.
"I have specially tuned methods for monochrome"
(deviceDepth == 1) ifTrue:[
DitherAlgorithm == #error ifTrue:[
^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
].
DitherAlgorithm == #pattern ifTrue:[
^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
].
^ self rgbImageAsMonoFormOn:aDevice
].
"and for 2plane greyscale (i.e. NeXTs)"
(deviceDepth == 2) ifTrue:[
DitherAlgorithm == #error ifTrue:[
^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
].
DitherAlgorithm == #pattern ifTrue:[
^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
].
^ self rgbImageAs2PlaneFormOn:aDevice
].
(deviceDepth == 8) ifTrue:[
^ self rgbImageAs8BitGreyFormOn:aDevice
].
"mhmh need another converter ...
till then we do:"
DitherAlgorithm == #error ifTrue:[
^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
].
DitherAlgorithm == #pattern ifTrue:[
^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
].
^ self rgbImageAsMonoFormOn:aDevice
!
rgbImageAsMonoFormOn:aDevice
"return a 1-bit monochrome form for aDevice from the rgb picture,
using a threshold algorithm.
(i.e. grey value < 0.5 -> black, grey value >= 0.5 -> white)."
^ self subclassResponsibility
!
rgbImageAsPatternDitheredGreyFormOn:aDevice
"return a dithered greyForm for aDevice from the palette picture.
works for any destination depth.
A slow algorithm, using draw into the form (which indirectly does
the dither) - should be rewritten."
^ self subclassResponsibility
!
rgbImageAs2PlaneFormOn:aDevice
"return a 2-bit device form for aDevice from the rgb picture,
using a threshold algorithm.
(i.e. grey value < 0.25 -> black // 0.25..0.5 -> darkgrey //
0.5 .. 0.75 -> lightgrey // > 0.75 -> white)."
^ self subclassResponsibility
!
rgbImageAs8BitGreyFormOn:aDevice
"return an 8-bit greyForm from the rgb picture"
^ self subclassResponsibility
!
rgbImageAsPseudoFormOn:aDevice
"return a pseudocolor form from the rgb-picture"
^ self subclassResponsibility
!
rgbImageAsTrueColorFormOn:aDevice
"return a truecolor form from the rgb-picture."
|bestFormat usedDeviceDepth usedDeviceBitsPerPixel depth
myDepth form imageBits destIndex srcIndex
rightShiftR rightShiftG rightShiftB shiftRed shiftGreen shiftBlue ok|
bestFormat := self bestSupportedImageFormatFor:aDevice.
usedDeviceDepth := bestFormat at:1.
usedDeviceBitsPerPixel := bestFormat at:2.
rightShiftR := (8 - aDevice bitsRed).
rightShiftG := (8 - aDevice bitsGreen).
rightShiftB := (8 - aDevice bitsBlue).
shiftRed := aDevice shiftRed.
shiftGreen := aDevice shiftGreen.
shiftBlue := aDevice shiftBlue.
myDepth := self bitsPerPixel.
myDepth == usedDeviceBitsPerPixel ifTrue:[
"/
"/ first, the trivial case, where the depths match
"/
imageBits := bytes.
] ifFalse:[
"/
"/ for now, only a few formats are supported
"/
((myDepth == 24) and:[usedDeviceBitsPerPixel == 16]) ifTrue:[
imageBits := ByteArray uninitializedNew:(width * height * 2).
"/ now, walk over the image and compose 16bit values from the r/g/b triples
ok := false.
%{
#ifdef NOTDEF
if (__isSmallInteger(_INST(height))
&& __isSmallInteger(_INST(width))
&& __isSmallInteger(rightShiftR)
&& __isSmallInteger(rightShiftG)
&& __isSmallInteger(rightShiftB)
&& __isSmallInteger(shiftRed)
&& __isSmallInteger(shiftGreen)
&& __isSmallInteger(shiftBlue)
&& __isByteArray(_INST(bytes))
&& __isByteArray(imageBits)) {
int rShRed = __intVal(rightShiftR),
rShGreen = __intVal(rightShiftG),
rShBlue = __intVal(rightShiftB),
lShRed = __intVal(shiftRed),
lShGreen = __intVal(shiftGreen),
lShBlue = __intVal(shiftBlue);
int x, y;
unsigned char *srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
char *dstPtr = _ByteArrayInstPtr(imageBits)->ba_element;
for (y=__intVal(_INST(height)); y > 0; y--) {
for (x=__intVal(_INST(width)); x > 0; x--) {
unsigned r, g, b, v;
r = srcPtr[0] >> rShRed;
g = srcPtr[1] >> rShGreen;
b = srcPtr[2] >> rShBlue;
v = r << lShRed;
v |= (g << lShGreen);
v |= (b << lShBlue);
#ifdef MSBFIRST
((short *)dstPtr)[0] = v;
#else
dstPtr[0] = (v>>8) & 0xFF;
dstPtr[1] = (v) & 0xFF;
#endif
dstPtr += 2;
srcPtr += 3;
}
}
ok = true;
}
#endif
%}.
ok ifFalse:[
"/ this fallback is only executed if type is not
"/ what the primitive expects; for example, if the bytes-instvar
"/ is not a ByteArray
rightShiftR := rightShiftR negated.
rightShiftG := rightShiftG negated.
rightShiftB := rightShiftB negated.
destIndex := 1.
srcIndex := 1.
0 to:height-1 do:[:y |
0 to:width-1 do:[:x |
|r g b v|
r := bytes at:srcIndex.
g := bytes at:(srcIndex + 1).
b := bytes at:(srcIndex + 2).
r := r bitShift:rightShiftR.
g := g bitShift:rightShiftG.
b := b bitShift:rightShiftB.
v := r bitShift:shiftRed.
v := v bitOr:(g bitShift:shiftGreen).
v := v bitOr:(b bitShift:shiftBlue).
imageBits wordAt:destIndex put:v MSB:true.
destIndex := destIndex + 2.
srcIndex := srcIndex + 3.
]
]
]
] ifFalse:[
((myDepth == 24) and:[usedDeviceBitsPerPixel == 32]) ifTrue:[
imageBits := ByteArray uninitializedNew:(width * height * 4).
"/ now, walk over the image and compose 32bit values from the r/g/b triples
ok := false.
%{
#ifdef NOTDEF
if (__isSmallInteger(_INST(height))
&& __isSmallInteger(_INST(width))
&& __isSmallInteger(rightShiftR)
&& __isSmallInteger(rightShiftG)
&& __isSmallInteger(rightShiftB)
&& __isSmallInteger(shiftRed)
&& __isSmallInteger(shiftGreen)
&& __isSmallInteger(shiftBlue)
&& __isByteArray(_INST(bytes))
&& __isByteArray(imageBits)) {
int rShRed = __intVal(rightShiftR),
rShGreen = __intVal(rightShiftG),
rShBlue = __intVal(rightShiftB),
lShRed = __intVal(shiftRed),
lShGreen = __intVal(shiftGreen),
lShBlue = __intVal(shiftBlue);
int x, y;
unsigned char *srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
char *dstPtr = _ByteArrayInstPtr(imageBits)->ba_element;
if ((rShRed == 0)
&& (rShGreen == 0)
&& (rShBlue == 0)) {
for (y=__intVal(_INST(height)); y > 0; y--) {
for (x=__intVal(_INST(width)); x > 0; x--) {
unsigned v;
v = srcPtr[0] << lShRed;
v |= (srcPtr[1] << lShGreen);
v |= (srcPtr[2] << lShBlue);
#ifdef MSBFIRST
((int *)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 += 3;
}
}
} else {
for (y=__intVal(_INST(height)); y > 0; y--) {
for (x=__intVal(_INST(width)); x > 0; x--) {
unsigned r, g, b, v;
r = srcPtr[0] >> rShRed;
g = srcPtr[1] >> rShGreen;
b = srcPtr[2] >> rShBlue;
v = r << lShRed;
v |= (g << lShGreen);
v |= (b << lShBlue);
#ifdef MSBFIRST
((int *)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 += 3;
}
}
}
ok = true;
}
#endif
%}.
ok ifFalse:[
"/ this fallback is only executed if type is not
"/ what the primitive expects; for example, if the bytes-instvar
"/ is not a ByteArray
rightShiftR := rightShiftR negated.
rightShiftG := rightShiftG negated.
rightShiftB := rightShiftB negated.
destIndex := 1.
srcIndex := 1.
0 to:height-1 do:[:y |
0 to:width-1 do:[:x |
|r g b v|
r := bytes at:srcIndex.
g := bytes at:(srcIndex + 1).
b := bytes at:(srcIndex + 2).
r := r bitShift:rightShiftR.
g := g bitShift:rightShiftG.
b := b bitShift:rightShiftB.
v := r bitShift:shiftRed.
v := v bitOr:(g bitShift:shiftGreen).
v := v bitOr:(b bitShift:shiftBlue).
imageBits doubleWordAt:destIndex put:v MSB:true.
destIndex := destIndex + 4.
srcIndex := srcIndex + 3.
]
]
]
].
]
].
imageBits isNil ifTrue:[
'IMAGE: unimplemented trueColor depth in rgbImageAsTrueColorFormOn:' errorPrintNL.
^ self rgbImageAsMonoFormOn: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:imageBits bitsPerPixel:usedDeviceBitsPerPixel depth:usedDeviceDepth
width:width height:height
x:0 y:0 toX:0 y:0.
^ form
"Created: 21.10.1995 / 02:15:18 / cg"
"Modified: 21.10.1995 / 19:30:11 / cg"
! !
!Image methodsFor:'converting palette images'!
paletteImageAsFormOn:aDevice
"return a device-form for the palette-image receiver"
|type|
((type := aDevice visualType) == #StaticGray) ifTrue:[
(aDevice depth == 8) ifTrue:[
^ self paletteImageAsGreyFormOn:aDevice
].
DitherAlgorithm == #pattern ifTrue:[
^ self paletteImageAsPatternDitheredGreyFormOn:aDevice
].
(aDevice depth == 2) ifTrue:[
^ self paletteImageAs2PlaneFormOn:aDevice
].
^ self paletteImageAsMonoFormOn:aDevice
].
(type == #TrueColor) ifTrue:[
^ self paletteImageAsTrueColorFormOn:aDevice
].
(type == #PseudoColor) ifTrue:[
^ self paletteImageAsPseudoFormOn:aDevice
].
"/ dump fallback: every device should implement b&w images ...
^ self paletteImageAsMonoFormOn:aDevice
!
paletteImageAsMonoFormOn:aDevice
"return a 1-bit mono-deviceForm from the palette image"
^ self subclassResponsibility
!
paletteImageAs2PlaneFormOn:aDevice
"return a 2-bit grey-deviceForm from the palette image"
^ self subclassResponsibility
!
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
!
paletteImageAsGreyFormOn:aDevice
"return an 8-bit grey-deviceForm from the palette image"
^ self subclassResponsibility
!
paletteImageAsPatternDitheredGreyFormOn:aDevice
"return a dithered grey-deviceForm from the palette image."
^ self subclassResponsibility
!
paletteImageAsTrueColorFormOn:aDevice
"return a true-color device-form for the palette-image receiver."
|depth myDepth nColors colorValues
scaleRed scaleGreen scaleBlue redShift greenShift blueShift
form imageBits bestFormat usedDeviceDepth usedDeviceBitsPerPixel destIndex ok|
"/ 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|
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:1.
usedDeviceBitsPerPixel := bestFormat at:2.
"/ 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
ok := false.
%{
#ifdef NOTDEF
if (__isSmallInteger(_INST(height))
&& __isSmallInteger(_INST(width))
&& __isArray(colorValues)
&& __isByteArray(_INST(bytes))
&& (myDepth == __MKSMALLINT(8))
&& __isByteArray(imageBits)) {
int x, y;
unsigned char *srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
char *dstPtr = _ByteArrayInstPtr(imageBits)->ba_element;
OBJ *ap = __ArrayInstPtr(colorValues)->a_element;
for (y=__intVal(_INST(height)); y > 0; y--) {
for (x=__intVal(_INST(width)); x > 0; x--) {
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;
}
}
ok = true;
}
#endif
%}.
ok ifFalse:[
"/ this fallback is only executed if type is not
"/ what the primitive expects; for example, if the bytes-instvar
"/ is not a ByteArray
destIndex := 1.
0 to:height-1 do:[:y |
0 to:width-1 do:[:x |
|colorIndex|
colorIndex := self valueAtX:x y:y.
imageBits wordAt:destIndex put:(colorValues at:colorIndex + 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
ok := false.
%{
#ifdef NOTDEF
if (__isSmallInteger(_INST(height))
&& __isSmallInteger(_INST(width))
&& __isArray(colorValues)
&& __isByteArray(_INST(bytes))
&& (myDepth == __MKSMALLINT(8))
&& __isByteArray(imageBits)) {
int x, y;
unsigned char *srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
char *dstPtr = _ByteArrayInstPtr(imageBits)->ba_element;
OBJ *ap = __ArrayInstPtr(colorValues)->a_element;
for (y=__intVal(_INST(height)); y > 0; y--) {
for (x=__intVal(_INST(width)); x > 0; x--) {
unsigned idx, v;
OBJ clr;
idx = *srcPtr++;
clr = ap[idx];
v = __intVal(clr);
#ifdef MSBFIRST
((short *)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;
}
}
ok = true;
}
#endif
%}.
ok ifFalse:[
destIndex := 1.
0 to:height-1 do:[:y |
0 to:width-1 do:[:x |
|colorIndex|
colorIndex := self valueAtX:x y:y.
imageBits doubleWordAt:destIndex put:(colorValues at:colorIndex + 1) MSB:true.
destIndex := destIndex + 4.
]
]
]
]
].
imageBits isNil ifTrue:[
'IMAGE: unimplemented trueColor depth in paletteImageAsTrueColorFormOn:' errorPrintNL.
^ self paletteImageAsMonoFormOn: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: 21.10.1995 / 19:30:26 / 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 == #StaticGray) ifTrue:[
(aDevice depth == pictureDepth) ifTrue:[
"greyscale is easy, if the depths match"
f := Form width:width height:height depth:pictureDepth on:aDevice.
f isNil ifTrue:[^ nil].
f initGC.
"if device has white at the opposite corner ..."
((aDevice blackpixel == 0) == (photometric == #blackIs0)) ifFalse:[
"have to invert bits"
f function:#copyInverted
].
aDevice drawBits:bytes depth:pictureDepth width:width height:height
x:0 y:0
into:(f id)
x:0 y:0 width:width height:height with:(f gcId).
^ f
].
"the image has more greylevels than the display - dither"
"
coming soon ...
DitherAlgorithm == #error ifTrue:[
^ self greyImageAsErrorDitheredGreyFormOn:aDevice
].
"
DitherAlgorithm == #pattern ifTrue:[
^ self greyImageAsPatternDitheredGreyFormOn:aDevice
].
"no dither, simply cut off information"
(aDevice depth == 1) ifTrue:[
"for monochrome, there is a special method to do this"
^ self greyImageAsMonoFormOn:aDevice
].
"the general case, will take as many bits from the image
as possible for the device"
^ self greyImageAsGreyFormOn:aDevice
].
(aDevice visualType == #PseudoColor or:[aDevice visualType == #GrayScale]) ifTrue:[
^ self greyImageAsPseudoFormOn:aDevice
].
(aDevice visualType == #TrueColor) ifTrue:[
^ self greyImageAsTrueColorFormOn:aDevice
].
self error:'cannot convert this format'.
^ nil
!
greyImageAsMonoFormOn:aDevice
"return a (thresholded) monochrome Form from the image."
^ self subclassResponsibility
!
greyImageAsPatternDitheredGreyFormOn:aDevice
"return a dithered greyForm from the grey image.
Works for any source/destination depths, but very very slow
since each pixel is processed individually.
Usually redefined by subclasses for more performance"
|f last
x0 "{Class: SmallInteger }"
w "{Class: SmallInteger }"
h "{Class: SmallInteger }"
run "{Class: SmallInteger }" |
Transcript showCr:'slow dithering ..'. Transcript endEntry.
w := width - 1.
h := height - 1.
"draw each pixel using dither color (let others do the dithering)
although the code is simple, its very slow"
f := Form width:width height:height depth:aDevice depth on:aDevice.
f isNil ifTrue:[^ nil].
f initGC.
0 to:h do:[:dstY |
x0 := 0.
run := 0.
last := nil.
self atY:dstY from:0 to:w do:[:x :srcColor |
|dstColor|
srcColor ~~ last ifTrue:[
(run ~~ 0) ifTrue:[
f fillRectangleX:x0 y:dstY width:run height:1.
].
run := 0.
dstColor := Color grey:(srcColor greyIntensity).
f paint:dstColor.
last := srcColor.
x0 := x
].
run := run + 1
].
f fillRectangleX:x0 y:dstY width:run height:1.
].
^ f
!
greyImageAsGreyFormOn:aDevice
"return an 8-bit Form from the grey image"
|wideBits pictureDepth f map nplanes ncells
inverse
mapSize "{ Class: SmallInteger }"
oldValue "{ Class: SmallInteger }"
newValue "{ Class: SmallInteger }"
shift "{ Class: SmallInteger }"
shift2 "{ Class: SmallInteger }"
shift3 "{ Class: SmallInteger }"
shift4 "{ Class: SmallInteger }" |
(aDevice depth == 8) ifFalse:[
'IMAGE: non-8 plane displays not supported' errorPrintNL.
^ self greyImageAsMonoFormOn:aDevice
].
pictureDepth := bitsPerSample at:1.
wideBits := ByteArray uninitializedNew:(width * height).
map := ByteArray uninitializedNew:(1 bitShift:pictureDepth).
"find the real number of server-planes"
nplanes := 8.
ncells := 256.
[aDevice ncells < ncells] whileTrue:[
nplanes := nplanes - 1.
ncells := ncells // 2
].
"prepare translation table"
shift := nplanes - pictureDepth.
shift2 := shift - pictureDepth.
shift3 := shift2 - pictureDepth.
shift4 := shift3 - pictureDepth.
inverse := aDevice blackpixel ~~ 0.
photometric == #blackIs0 ifFalse:[
inverse := inverse not
].
mapSize := map size.
1 to:mapSize do:[:index |
oldValue := index - 1.
newValue := oldValue bitShift:shift.
newValue := newValue bitOr:(oldValue bitShift:shift2).
newValue := newValue bitOr:(oldValue bitShift:shift3).
newValue := newValue bitOr:(oldValue bitShift:shift4).
inverse ifTrue:[
map at:(map size - index + 1) put:newValue
] ifFalse:[
map at:index put:newValue
]
].
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 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
!
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 grey:(100.0 / 256.0 * grey))
]
] ifFalse:[
usedColors do:[:grey |
colorMap at:(grey + 1) put:(Color grey:(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 grey:(i - 1) * range).
].
] ifFalse:[
1 to:nColors do:[:i |
colorMap at:(nColors - i + 1) put:(Color grey:(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
!
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 nColors colorValues
scaleDown scaleRed scaleGreen scaleBlue redShift blueShift greenShift
form imageBitsdestIndex
bestFormat usedDeviceDepth usedDeviceBitsPerPixel imageBits destIndex|
"/ 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:1.
usedDeviceBitsPerPixel := bestFormat at:2.
"/ 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 paletteImageAsMonoFormOn: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: 21.10.1995 / 19:30:37 / cg"
! !
!Image methodsFor:'image manipulations'!
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)]
"
!
colorMapProcessing:aBlock
"a helper for all kinds of colormap manipulations.
The argument aBlocks is called for every colormap entry, and the returned value
will replace that 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)
]
]
!
lightened
"return a new image which is slightly brighter than the receiver.
The receiver must be a palette image (currently).
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
"
!
darkened
"return a new image which is slightly darker than the receiver.
The receiver must be a palette image (currently).
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
"
!
magnifyBy:scale
"obsolete: has been renamed to magnifiedBy: for ST-80 compatibility
and name consistency ..."
self obsoleteMethodWarning.
^ self magnifiedBy:scale
!
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)"
!
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)"
!
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)
"
!
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
!
rotated:degrees
"return a new image from the old one, by rotating the image
degrees clockwise.
Currently, only rotation by a multiple of 90 degrees is implemented."
|w "{Class: SmallInteger }"
h "{Class: SmallInteger }"
c2 "{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
].
newBytesPerRow := ((height * self depth) + 7) // 8.
newBits := ByteArray uninitializedNew:(newBytesPerRow * width).
newImage := self species new.
newImage bits:newBits.
newImage width:height.
newImage height:width.
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.
0 to:w do:[:col |
newImage atX:c2 y:col putValue:(self valueAtX:col y:row).
]
]
].
d == 180 ifTrue:[
0 to:h do:[:row |
0 to:w do:[:col |
newImage atX:(h-row) y:(w-col) putValue:(self valueAtX:col y:row).
]
]
].
d == 270 ifTrue:[
0 to:h do:[:row |
0 to:w do:[:col |
newImage atX:row y:(w-col) putValue:(self valueAtX:col y:row).
]
]
].
^ newImage
!
hardRotated:degrees
self error:'not yet implemented'
!
blurr
"inplace blurr"
"not yet implemented"
"flush device info"
self restored
! !
!Image methodsFor:'private'!
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"
!
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
!
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 is taken."
|bestDeviceDepth bestDeviceBitsPerPixel myDepth maxDepth maxBitsPerPixel|
myDepth := self bitsPerPixel.
maxBitsPerPixel := 0.
aDevice supportedImageFormats do:[:entry |
|deviceImageDepth deviceImageBitsPerPixel|
deviceImageDepth := entry at:1.
deviceImageBitsPerPixel := entry at:2.
deviceImageBitsPerPixel > maxBitsPerPixel ifTrue:[
maxBitsPerPixel := deviceImageBitsPerPixel.
maxDepth := deviceImageDepth.
].
deviceImageDepth >= myDepth ifTrue:[
deviceImageDepth == myDepth ifTrue:[
"/ take the better one ...
(bestDeviceDepth isNil
or:[(bestDeviceBitsPerPixel ~~ bestDeviceDepth)
and:[deviceImageDepth == deviceImageBitsPerPixel]]) ifTrue:[
bestDeviceDepth := deviceImageDepth.
bestDeviceBitsPerPixel := deviceImageBitsPerPixel.
]
] ifFalse:[
"/ take the next-larger depth
(bestDeviceDepth isNil
or:[deviceImageBitsPerPixel < bestDeviceBitsPerPixel]) ifTrue:[
bestDeviceDepth := deviceImageDepth.
bestDeviceBitsPerPixel := deviceImageBitsPerPixel.
]
]
].
].
bestDeviceDepth isNil ifTrue:[
maxBitsPerPixel == 0 ifTrue:[
bestDeviceDepth := bestDeviceBitsPerPixel := aDevice depth.
] ifFalse:[
bestDeviceDepth := maxDepth.
bestDeviceBitsPerPixel := maxBitsPerPixel
]
].
^ Array with:bestDeviceDepth with:bestDeviceBitsPerPixel
"Created: 21.10.1995 / 02:17:48 / cg"
"Modified: 21.10.1995 / 03:52:45 / cg"
! !
!Image methodsFor: 'binary storage'!
storeBinaryDefinitionOn: stream manager: manager
"store a binary representation of the receiver on stream.
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.
!
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.
! !