--- a/Color.st Wed Dec 21 20:19:18 1994 +0100
+++ b/Color.st Mon Feb 06 01:30:10 1995 +0100
@@ -11,13 +11,13 @@
"
Object subclass:#Color
- instanceVariableNames:'redVal greenVal blueVal device colorId ditherForm'
- classVariableNames:'Lobby
+ instanceVariableNames:'redVal greenVal blueVal device colorId ditherForm writable'
+ classVariableNames:'Lobby Cells
Black White LightGrey Grey DarkGrey
Pseudo0 Pseudo1 PseudoAll
Red Green Blue
DitherColors RetryAllocation
- FixColors FixSpec'
+ FixColors NumFixRed NumFixGreen NumFixBlue'
poolDictionaries:''
category:'Graphics-Support'
!
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Color.st,v 1.15 1994-10-28 03:13:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.16 1995-02-06 00:30:10 claus Exp $
'!
!Color class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Color.st,v 1.15 1994-10-28 03:13:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.16 1995-02-06 00:30:10 claus Exp $
"
!
@@ -66,45 +66,65 @@
with the devices depth. The plain colors needed by the ditherForm are found in its
colormap (as usual for bitmaps).
+ The default algorithm for color allocation is to ask the display for colors as
+ new colors are created. When running out of colors, dithered colors will be used,
+ using existing nearest colors and a dither pattern to aproximate the color.
+ There could be situations, where no good colors are available for the dither, leading
+ to ugly looking dither colors.
+ This can be avoided by preallocating a set of colors over the complete range, which
+ makes certain that appropriate colors are later available for the dither process.
+ To do so, add a statement like: 'Color getColors5x5x5' to the startup.rc file.
+ (beside 5x5x5, there are various other size combinations available).
+ However, doing so may make things worse when displaying bitmap images, since this
+ preallocated table may steal colors from the image ...
+
Instance variables:
- redVal <Number> the red component (0..100)
- greenVal <Number> the green component (0..100)
- blueVal <Number> the blue component (0..100)
- device <aDevice> the device I am on, or nil
- colorId <anObject> some device dependent identifier (or nil if dithered)
- ditherForm <aForm> the Form to dither this color (if non-nil)
+ redVal <Number> the red component (0..100)
+ greenVal <Number> the green component (0..100)
+ blueVal <Number> the blue component (0..100)
+ device <Device> the device I am on, or nil
+ colorId <Object> some device dependent identifier (or nil if dithered)
+ ditherForm <Form> the Form to dither this color (if non-nil)
+ writable <Boolean> true if this is for a writable color cell
Class variables:
- Lobby <Registry> keeps track of dead colors
+ Lobby <Registry> all colors in use - keeps track of already allocated
+ colors for reuse and finalization.
+ Cells <Registry> keeps track of allocated writable color cells
- Black <Color> for fast return of black
- White <Color> for fast return of white
- Grey <Color> for fast return of grey
- LightGrey <Color> for fast return of lightGrey
- DarkGrey <Color> for fast return of darkGrey
-
- Pseudo0 <Color> a color with 0 as handle (for forms and bitblit)
- Pseudo1 <Color> a color with 1 as handle (for forms)
- PseudoAll <Color> a color with allPlanes as handle (for bitblit)
+ FixColors <Array> preallocated colors for dithering on Display
+ NumRedFix <Integer> number of distinct red values in FixColors
+ NumGreenFix <Integer> number of distinct green values in FixColors
+ NumBlueFix <Integer> number of distinct blue values in FixColors
+
+ Black <Color> for fast return of black
+ White <Color> for fast return of white
+ Grey <Color> for fast return of grey
+ LightGrey <Color> for fast return of lightGrey
+ DarkGrey <Color> for fast return of darkGrey
- Red <Color> red, needed for dithering
- Green <Color> green, for dithering
- Blue <Color> blue, for dithering
+ Pseudo0 <Color> a color with 0 as handle (for forms and bitblit)
+ Pseudo1 <Color> a color with 1 as handle (for forms)
+ PseudoAll <Color> a color with allPlanes as handle (for bitblit)
- DitherColors <Collection> some preallocated colors for dithering
- (kept, so they are available when needed)
+ Red <Color> red, needed for dithering
+ Green <Color> green, for dithering
+ Blue <Color> blue, for dithering
- RetryAllocation <Boolean> this flag controls how a request for a
- color should be handled which failed previously.
- I.e. a color is asked for, which was dithered
- the last time. Since it could happen, that in
- the meantime more colors became free, the request
- might succeed this time - however, your screen may
- look a bit funny, due to having both dithered and
- undithered versions around.
- The default is true, which means: do retry
+ DitherColors <Collection> some preallocated colors for dithering
+ (kept, so they are available when needed)
+
+ RetryAllocation <Boolean> this flag controls how a request for a
+ color should be handled which failed previously.
+ I.e. a color is asked for, which was dithered
+ the last time. Since it could happen, that in
+ the meantime more colors became free, the request
+ might succeed this time - however, your screen may
+ look a bit funny, due to having both dithered and
+ undithered versions around.
+ The default is true, which means: do retry
"
! !
@@ -122,7 +142,8 @@
"want to be informed when returning from snapshot"
ObjectMemory addDependent:self.
- RetryAllocation := true
+ RetryAllocation := true.
+ NumFixRed := NumFixGreen := NumFixBlue := 0.
].
!
@@ -139,7 +160,10 @@
Blue := (self red:0 green:0 blue:100) exactOn:Display.
"preallocate some colors for dithering
- - otherwise, they may not be available when we need them ..."
+ - otherwise, they may not be available when we need them ...
+ these are: black, white, grey50,
+ red, green, blue, yellow, cyan and magenta.
+ "
colors := OrderedCollection new.
colors add:((self red:50 green:50 blue:50) exactOn:Display).
@@ -159,14 +183,14 @@
!
getColorsRed:nRed green:nGreen blue:nBlue
- "preallocates a 5x5x5 colorMap and later uses those colors only.
+ "preallocates a nR x nG x nB colorMap for later use in dithering.
Doing so has the advantage that the system will never run out of colors,
however, colors may be either inexact or dithered."
|nR "{Class: SmallInteger }"
nG "{Class: SmallInteger }"
nB "{Class: SmallInteger }"
- dR dG dB red green blue dstIndex|
+ dR dG dB red green blue dstIndex clr round|
nR := nRed.
nG := nGreen.
@@ -177,7 +201,8 @@
dB := 100.0 / (nB - 1).
FixColors := Array new:(nR * nG * nB).
- FixSpec := Array with:nR with:nG with:nB.
+
+ round := 0.
dstIndex := 1.
1 to:nR do:[:sR |
@@ -186,13 +211,28 @@
green := dG * (sG - 1).
1 to:nB do:[:sB |
blue := dB * (sB - 1).
- FixColors
- at:dstIndex
- put:((self red:red green:green blue:blue) exactOn:Display).
+ clr := (self red:red green:green blue:blue) exactOn:Display.
+ clr isNil ifTrue:[
+ round == 0 ifTrue:[
+ 'COLOR: collect garbage to reclaim colors' errorPrintNL.
+ ObjectMemory garbageCollect.
+ round := 1.
+ ].
+ clr := (self red:red green:green blue:blue) exactOn:Display.
+ ].
+ clr isNil ifTrue:[
+ FixColors := nil.
+ self error:'failed to allocate color'.
+ ^ self
+ ].
+ FixColors at:dstIndex put:clr.
dstIndex := dstIndex + 1
]
]
- ]
+ ].
+ NumFixRed := nR.
+ NumFixGreen := nG.
+ NumFixBlue := nB.
!
getColors5x5x5
@@ -282,10 +322,33 @@
self flushDeviceColors
].
(something == #returnFromSnapshot) ifTrue:[
- self getPrimaryColors
+ self getPrimaryColors.
+ FixColors notNil ifTrue:[
+ self getColorsRed:NumFixRed
+ green:NumFixGreen
+ blue:NumFixBlue
+ ]
]
! !
+!Color class methodsFor:'accessing '!
+
+fixColors
+ ^ FixColors
+!
+
+numFixRed
+ ^ NumFixRed
+!
+
+numFixGreen
+ ^ NumFixGreen
+!
+
+numFixBlue
+ ^ NumFixBlue
+! !
+
!Color class methodsFor:'instance creation'!
white
@@ -428,6 +491,29 @@
^ self red:100 green:0 blue:100
!
+variableColorOn:aDevice
+ "return a variable color (i.e. allocate a writable colorcell) on
+ aDevice. The returned color is not shared and its rgb components
+ are initially undefined. The components can be set to any value
+ using Color>>red:green:blue. Care should be taken, since this call
+ fails on static color or b&w displays (i.e. it depends on the device
+ being a pseudocolor device using colormaps)."
+
+ |c lutIndex|
+
+ lutIndex := aDevice colorCell.
+ lutIndex isNil ifTrue:[^ nil].
+
+ c := self new.
+ c setDevice:aDevice colorId:lutIndex.
+ c setWritable:true.
+ Cells isNil ifTrue:[
+ Cells := Registry new.
+ ].
+ Cells register:c.
+ ^ c
+!
+
red:r green:g blue:b
"return a color from red, green and blue values;
the arguments, r, g and b are interpreted as percent (0..100)"
@@ -545,8 +631,39 @@
"first try exact color"
- |delta minDelta bestSoFar rr rg rb|
+ |delta minDelta bestSoFar rr rg rb
+ sR "{ Class: SmallInteger }"
+ sG "{ Class: SmallInteger }"
+ sB "{ Class: SmallInteger }"
+ idx "{ Class: SmallInteger }"
+ nR "{ Class: SmallInteger }"
+ nG "{ Class: SmallInteger }"
+ nB "{ Class: SmallInteger }"
+ rI "{ Class: SmallInteger }"
+ gI "{ Class: SmallInteger }"
+ bI "{ Class: SmallInteger }"|
+ "
+ if there are preallocated colors, thungs are much easier ...
+ "
+ (FixColors notNil and:[aDevice == Display]) ifTrue:[
+ "
+ round to the step given by FixColors
+ "
+ nR := NumFixRed.
+ nG := NumFixGreen.
+ nB := NumFixBlue.
+
+ sR := 100 // (nR - 1).
+ sG := 100 // (nG - 1).
+ sB := 100 // (nB - 1).
+
+ rI := (r + (sR // 2)) // sR.
+ gI := (g + (sG // 2)) // sG.
+ bI := (b + (sB // 2)) // sB.
+ idx := (((rI * nG) + gI) * nB + bI) + 1.
+ ^ FixColors at:idx
+ ].
"round to 1/300 i.e. to about 0.3%"
"/ rr := (r * 3.0) rounded / 3.0.
@@ -565,7 +682,7 @@
|cr cg cb|
(aColor device == aDevice) ifTrue:[
- (aColor colorId notNil) ifTrue:[
+ aColor colorId notNil ifTrue:[
"/ cr := (aColor red * 3.0) rounded / 3.0.
"/ cg := (aColor green * 3.0) rounded / 3.0.
@@ -609,7 +726,39 @@
"first try exact color"
- |delta minDelta bestSoFar rr rg rb colors|
+ |delta minDelta bestSoFar rr rg rb colors
+ sR "{ Class: SmallInteger }"
+ sG "{ Class: SmallInteger }"
+ sB "{ Class: SmallInteger }"
+ idx "{ Class: SmallInteger }"
+ nR "{ Class: SmallInteger }"
+ nG "{ Class: SmallInteger }"
+ nB "{ Class: SmallInteger }"
+ rI "{ Class: SmallInteger }"
+ gI "{ Class: SmallInteger }"
+ bI "{ Class: SmallInteger }"|
+
+ "
+ if there are preallocated colors, thungs are much easier ...
+ "
+ (FixColors notNil and:[aDevice == Display]) ifTrue:[
+ "
+ round to the step given by FixColors
+ "
+ nR := NumFixRed.
+ nG := NumFixGreen.
+ nB := NumFixBlue.
+
+ sR := 100 // (nR - 1).
+ sG := 100 // (nG - 1).
+ sB := 100 // (nB - 1).
+
+ rI := (r + (sR // 2)) // sR.
+ gI := (g + (sG // 2)) // sG.
+ bI := (b + (sB // 2)) // sB.
+ idx := (((rI * nG) + gI) * nB + bI) + 1.
+ ^ FixColors at:idx
+ ].
"round to 1/300 i.e. to about 0.3%"
@@ -647,6 +796,9 @@
]
].
+ "
+ Q: how should component errors be weighted ?
+ "
delta := ((rr - cr) squared * 3)
+ ((rg - cg) squared * 4)
+ ((rb - cb) squared * 2).
@@ -910,7 +1062,8 @@
"a color died - free the device color"
colorId notNil ifTrue:[
- device freeColor:colorId
+ device freeColor:colorId.
+ colorId := nil.
]
! !
@@ -924,12 +1077,18 @@
restored
"private: color has been restored (either from snapin or binary store);
- flush device stuff"
+ flush device stuff or reallocate a cell."
redVal notNil ifTrue:[
ditherForm := nil.
device := nil.
colorId := nil
+ ] ifFalse:[
+ "a variable color has been restored"
+ (colorId notNil and:[writable and:[device notNil]]) ifTrue:[
+ colorId := device colorCell.
+ device setColor:colorId red:redVal green:greenVal blue:blueVal
+ ]
]
!
@@ -965,6 +1124,10 @@
device := aDevice
!
+setWritable:aBoolean
+ writable := aBoolean
+!
+
setDevice:aDevice colorId:aNumber
"private:set device and colorId"
@@ -1002,6 +1165,7 @@
"find the 2 bounding colors"
Lobby contentsDo:[:aColor |
aColor colorId notNil ifTrue:[
+
Color withHLSFromRed:aColor red green:aColor green blue:aColor blue do:[:h :l :s |
| cl |
@@ -1068,7 +1232,6 @@
hiH := nil.
Lobby contentsDo:[:aColor |
-
aColor colorId notNil ifTrue:[
Color withHLSFromRed:aColor red green:aColor green blue:aColor blue do:[:h :l :s |
| cl ch cs|
@@ -1261,14 +1424,11 @@
idx "{ Class: SmallInteger }"
where reverse dWhat t|
- FixColors notNil ifTrue:[
-"/ '' printNL.
-"/ 'want: ' print. redVal print. ' ' print. greenVal print.
-"/ ' ' print. blueVal printNL.
+ (FixColors notNil and:[aDevice == Display]) ifTrue:[
- nR := (FixSpec at:1).
- nG := (FixSpec at:2).
- nB := (FixSpec at:3).
+ nR := NumFixRed.
+ nG := NumFixGreen.
+ nB := NumFixBlue.
sR := 100 // (nR - 1).
sG := 100 // (nG - 1).
@@ -1427,7 +1587,8 @@
|errR errG errB f usedColors wantR wantG wantB clr
dir "{ Class: SmallInteger }"
start "{ Class: SmallInteger }"
- end "{ Class: SmallInteger }" |
+ end "{ Class: SmallInteger }"
+ map|
errR := 0.
errG := 0.
@@ -1435,7 +1596,8 @@
"get a form and clear it"
f := Form width:4 height:4 depth:(aDevice depth) on:aDevice.
- usedColors := Set new.
+"/ usedColors := Set new.
+ map := IdentityDictionary new.
0 to:3 do:[:x |
x even ifTrue:[
@@ -1476,7 +1638,9 @@
f paint:clr.
f displayPointX:x y:y.
- usedColors add:clr.
+ map at:clr colorId + 1 put:clr.
+
+"/ usedColors add:clr.
"compute the new error"
errR := wantR - clr red.
@@ -1485,7 +1649,8 @@
].
].
- f colorMap:usedColors.
+"/ f colorMap:usedColors.
+ f colorMap:map.
"
'hard dither' printNewline.
"
@@ -1676,7 +1841,7 @@
"still none found, do a hard dither"
(id isNil and:[form isNil]) ifTrue:[
- FixColors notNil ifTrue:[
+ (FixColors notNil and:[aDevice == Display]) ifTrue:[
self fixDitherRed:redVal green:greenVal blue:blueVal on:aDevice
into:[:c :f | newColor := c. form := f].
newColor notNil ifTrue:[^ newColor].
@@ -1821,22 +1986,25 @@
if one already exists, return the one. If no exact match is found,
search for one with an error less than the argument error (in percent)."
- |newColor id sR sG sB
+ |newColor id
+ sR "{ Class: SmallInteger }"
+ sG "{ Class: SmallInteger }"
+ sB "{ Class: SmallInteger }"
idx "{ Class: SmallInteger }"
- nR "{ Class: SmallInteger }"
- nG "{ Class: SmallInteger }"
- nB "{ Class: SmallInteger }"
- rI "{ Class: SmallInteger }"
- gI "{ Class: SmallInteger }"
- bI "{ Class: SmallInteger }"|
+ nR "{ Class: SmallInteger }"
+ nG "{ Class: SmallInteger }"
+ nB "{ Class: SmallInteger }"
+ rI "{ Class: SmallInteger }"
+ gI "{ Class: SmallInteger }"
+ bI "{ Class: SmallInteger }"|
"if I'am already assigned to that device ..."
(device == aDevice) ifTrue:[^ self].
- FixColors notNil ifTrue:[
- nR := (FixSpec at:1).
- nG := (FixSpec at:2).
- nB := (FixSpec at:3).
+ (FixColors notNil and:[aDevice == Display]) ifTrue:[
+ nR := NumFixRed.
+ nG := NumFixGreen.
+ nB := NumFixBlue.
sR := 100 // (nR - 1).
sG := 100 // (nG - 1).
@@ -1953,6 +2121,34 @@
"(Color grey:50) isGreyColor"
"(Color red) isGreyColor"
+!
+
+averageColor
+ "return the average color - thats myself.
+ This method has been added for compatibility with the image
+ protocol."
+
+ ^ self
+!
+
+averageColorIn:aRectangle
+ "return the average color - thats myself.
+ This method has been added for compatibility with the image
+ protocol."
+
+ ^ self
+!
+
+greyIntensity
+ "return the grey intensity in percent [0..100]"
+
+ ^ (0.3 * redVal) + (0.6 * greenVal) + (0.1 * blueVal)
+!
+
+brightness
+ "ST80 compatibility: return the grey intensity in [0..1]"
+
+ ^ ((0.3 * redVal) + (0.6 * greenVal) + (0.1 * blueVal)) / 100
! !
!Color methodsFor:'accessing'!
@@ -1984,18 +2180,6 @@
^ blueVal
!
-greyIntensity
- "return the grey intensity in percent [0..100]"
-
- ^ (0.3 * redVal) + (0.6 * greenVal) + (0.1 * blueVal)
-!
-
-brightness
- "ST80 compatibility: return the grey intensity in [0..1]"
-
- ^ ((0.3 * redVal) + (0.6 * greenVal) + (0.1 * blueVal)) / 100
-!
-
hue
"return the hue in degrees [0..360]"
@@ -2061,11 +2245,19 @@
^ device
!
-deviceRedValue
- "return the value of the red component in device metrics.
- (usually 16bit in X; but could be different on other systems)"
+writable
+ "return true, if this is a writable colorcell"
+
+ ^ writable == true
+!
- ^ device redComponentOfColor:colorId
+deviceRed
+ "return the actual value of the red component in percent."
+
+ |v|
+
+ device getRGBFrom:colorId into:[:r :g :b | v := r].
+ ^ v
"
(Color yellow on:Display) deviceRedValue
@@ -2073,25 +2265,50 @@
"
!
-deviceGreenValue
- "return the value of the green component in device metrics.
+deviceGreen
+ "return the actual value of the green component in percent.
(usually 16bit in X; but could be different on other systems)"
- ^ device greenComponentOfColor:colorId
+ |v|
+
+ device getRGBFrom:colorId into:[:r :g :b | v := g].
+ ^ v
+!
+
+deviceBlue
+ "return the actual value of the blue component in percent."
+
+ |v|
+
+ device getRGBFrom:colorId into:[:r :g :b | v := b].
+ ^ v
!
-deviceBlueValue
- "return the value of the blue component in device metrics.
- (usually 16bit in X; but could be different on other systems)"
+red:r green:g blue:b
+ "set r/g/b components in percent. This method will change the color lookup
+ table in pseudocolor devices.
+ This is only allowed for writable colors (i.e. those allocated with
+ Color>>variableColorOn: on pseudoColor displays).
+ Using this may make your code unportable, since it depends on a display
+ using palettes (i.e. it will not work on greyScale or b&w displays)."
+
+ (colorId isNil or:[redVal notNil]) ifTrue:[
+ self error:'not allowed for shared colors'
+ ].
+ device setColor:colorId red:r green:g blue:b
- ^ device blueComponentOfColor:colorId
-!
+ "
+ |c|
-deviceRedValue:r deviceGreenValue:g deviceBlueValue:b
- "set r/g/b components in device metrics.
- (usually 16bit values in X; but could be different on other systems)"
-
- device setColor:colorId red:r asFloat green:g asFloat blue:b asFloat
+ c := Color variableColorOn:Display.
+ c inspect.
+ (Delay forSeconds:5) wait.
+ c red:100 green:0 blue:0.
+ (Delay forSeconds:5) wait.
+ c red:0 green:100 blue:0.
+ (Delay forSeconds:5) wait.
+ c red:0 green:0 blue:100.
+ "
! !
!Color methodsFor:'inspecting'!