"

 COPYRIGHT (c) 1992-93 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:#Color

       instanceVariableNames:'redVal greenVal blueVal device colorId ditherForm'

       classVariableNames:'lobby

                           Black White LightGrey Grey DarkGrey

                           Pseudo0 Pseudo1 PseudoAll

                           Red Green Blue DitherColors'

       poolDictionaries:''

       category:'Graphics-Support'

!

Color comment:'

COPYRIGHT (c) 1992-93 by Claus Gittinger

              All Rights Reserved

see Color documentation for more info

%W% %E%

totally rewritten summer 92 by claus (from XColor)

'!

!Color class methodsFor:'documentation'!

documentation

    "

Color represents colors in a device independent manner, main info I keep about

mySelf are the red, green and blue components in percent (0 .. 100).

The device specific color can be aquired by sending a color the 'on:aDevice' message,

which will return a color with the same rgb values as the receiver but specific

for that device.

Colors can be pure or dithered, depending on the capabilities of the device. 

For plain colors, the colorId-instvar is a handle (usually lookup-table entry) for that

device. For dithered colors, the colorId is nil and ditherForm specifies the form

used to dither that color (which can have a colormap and need 2 or more plain colors).

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)

Class variables:

lobby           <Registry>      keeps track of dead colors

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)

Red             <Color>         red, needed for dithering

Green           <Color>         green, for dithering

Blue            <Color>         blue, for dithering

DitherColors    <Collection>    some preallocated colors for dithering

                                (kept, so they are available when needed)

%W% %E%

totally rewritten summer 92 by claus (from XColor)

    "

! !

!Color class methodsFor:'initialization'!

initialize

    "setup tracker of known colors and initialize classvars with

     heavily used colors"

    lobby isNil ifTrue:[

        lobby := Registry new.

        self getPrimaryColors.

        "want to be informed when returning from snapshot"

        ObjectMemory addDependent:self.

        Smalltalk at:#ColorValue put:self "for ST-80 compatibility"

    ].

!

getPrimaryColors

    White := (self red:100 green:100 blue:100) exactOn:Display.

    Black := (self red:0 green:0 blue:0) exactOn:Display.

    Display hasColors ifTrue:[

        Red := (self red:100 green:0 blue:0) exactOn:Display.

        Green := (self red:0 green:100 blue:0) exactOn:Display.

        Blue := (self red:0 green:0 blue:100) exactOn:Display.

        Display ncells < 256 ifTrue:[

             "on low-color resolution displays, allocate some colors

              for dithering - otherwise, they may not be available when

              we need them ..."

             DitherColors := OrderedCollection new.

             DitherColors add:((self red:100 green:100 blue:0) exactOn:Display).

             DitherColors add:((self red:100 green:0 blue:100) exactOn:Display).

             DitherColors add:((self red:0 green:100 blue:100) exactOn:Display).

        ]

    ]

!

flushDeviceColors

    "unassign all colors from their device"

    lobby contentsDo:[:aColor |

        aColor resetDevice.

        lobby changed:aColor

    ]

!

update:something

    (something == #restarted) ifTrue:[

        self flushDeviceColors

    ].

    (something == #returnFromSnapshot) ifTrue:[

        self getPrimaryColors

    ]

! !

!Color class methodsFor:'instance creation'!

white

    "return the white-color"

    White isNil ifTrue:[

        White := (self red:100 green:100 blue:100) exactOn:Display

    ].

    ^ White

!

black

    "return the black-color"

    Black isNil ifTrue:[

        Black := (self red:0 green:0 blue:0) exactOn:Display

    ].

    ^ Black

!

mediumGrey

    "return medium-grey color"

    ^ self grey

!

veryLightGrey

    ^ self grey:87

!

lightGrey

    "return light-grey color -

     take value from resource file - 67% is very dark on some, very light

     on other displays ... sigh"

    LightGrey isNil ifTrue:[

        LightGrey := self grey:(Resource name:'COLOR_LIGHTGREY_VALUE'

                                      default:67 

                                     fromFile:'Smalltalk.rs')

    ].

    ^ LightGrey

!

darkGrey

    "return dark-grey color -

     take value from resource file - 33% is very dark on some, very light

     on other displays ... sigh"

    DarkGrey isNil ifTrue:[

        DarkGrey := self grey:(Resource name:'COLOR_DARKGREY_VALUE'

                                     default:33

                                    fromFile:'Smalltalk.rs')

    ].

    ^ DarkGrey

!

veryDarkGrey

    ^ self grey:13

!

grey

    "return a medium grey color -

     take value from resource file - 50% is very dark on some, very light

     on other displays ... sigh"

    Grey isNil ifTrue:[

        Grey := self grey:(Resource name:'COLOR_GREY_VALUE' 

                                 default:50

                                fromFile:'Smalltalk.rs')

    ].

    ^ Grey

!

grey:grey

    "return a grey color. The argument, grey is interpreted as

     percent (0..100)."

    ^ self red:grey green:grey blue:grey

!

gray

    "return grey"

    ^ self grey

!

lightGray

    "return lightGrey"

    ^ self lightGrey

!

darkGray

    "return darkGrey"

    ^ self darkGrey

!

red

    "return red"

    Red isNil ifTrue:[

        Red := self red:100 green:0 blue:0.

    ].

    ^ Red

!

green

    "return green"

    Green isNil ifTrue:[

        Green := self red:0 green:100 blue:0

    ].

    ^ Green

!

blue

    "return blue"

    Blue isNil ifTrue:[

        Blue := self red:0 green:0 blue:100

    ].

    ^ Blue

!

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

    |newColor rr rg rb|

    "round to 1/300 i.e. to about 0.33%"

    rr := (r * 3) rounded / 3.0.

    rg := (g * 3) rounded / 3.0.

    rb := (b * 3) rounded / 3.0.

    "look if already known"

    lobby contentsDo:[:aColor |

        (rr = aColor red) ifTrue:[

            (rg = aColor green) ifTrue:[

                (rb = aColor blue) ifTrue:[

                    ^ aColor

                ]

            ]

        ]

    ].

    newColor := self basicNew setRed:rr green:rg blue:rb device:nil.

    lobby register:newColor.

    ^ newColor

!

name:aString

    "return a named color - or try do do as good as possible"

    ^ self nameOrDither:aString

!

nameOrDither:aString

    "return a named color - if the exact color is not available,

     return a dithered color"

    Display getRGBFromName:aString into:[:r :g :b |

        r notNil ifTrue:[

            ^ self red:r green:g blue:b

        ].

    ].

    self error:'no color named ' , aString.

    ^ nil

    "Color nameOrDither:'Brown'"

!

nameOrNearest:aString

    "return a named color - or its nearest match"

    |id newColor|

    id := Display colorNamed:aString.

    id isNil ifTrue:[

        ObjectMemory scavenge.

        id := Display colorNamed:aString.

        id isNil ifTrue:[^ nil].

    ].

    newColor := self basicNew.

    Display getRGBFrom:id into:[:r :g :b |

        newColor setRed:r green:g blue:b device:Display

    ].

    newColor colorId:id.

    lobby register:newColor.

    ^ newColor

!

nearestColorRed:r green:g blue:b error:error on:aDevice

    "return a device color on aDevice with rgb values

     same or near r/g/b, if there is one, nil otherwise.

     Near is defined as having an error less than the argument

     error (in percent). The error is computed by the color

     vector distance (which is not the best possible solution)."

    "first try exact color"

    |delta minDelta bestSoFar rr rg rb|

    "round to 1/300 i.e. to about 0.3%"

    rr := (r * 3) rounded / 3.0.

    rg := (g * 3) rounded / 3.0.

    rb := (b * 3) rounded / 3.0.

    lobby contentsDo:[:aColor |

        (aColor device == aDevice) ifTrue:[

            (aColor colorId notNil) ifTrue:[

                (rr = aColor red) ifTrue:[

                    (rg = aColor green) ifTrue:[

                        (rb = aColor blue) ifTrue:[

                            ^ aColor

                        ]

                    ]

                ]

            ]

        ]

    ].

    "exact color was not available, search for the one with the

     smallest delta"

    minDelta := 999999.

    lobby contentsDo:[:aColor |

        (aColor device == aDevice) ifTrue:[

            (aColor colorId notNil) ifTrue:[

                delta := ((rr - aColor red) squared * 0.3)

                         + ((rg - aColor green) squared * 0.6)

                         + ((rb - aColor blue) squared * 0.1).

                delta < minDelta ifTrue:[

                    bestSoFar := aColor.

                    minDelta := delta

                ]

            ]

        ]

    ].

    minDelta < error squared ifTrue:[

        ^ bestSoFar

    ].

    ^ nil

!

hue:h light:l saturation:s

    "return a color from hue, light and saturation values"

    self withRGBFromHue:h light:l saturation:s do:[:r :g :b |

        ^ self red:r green:g blue:b

    ]

!

noColor

    "return a special color which, when used for bit-blitting will

     behave like a 0-color (i.e. have a device-pixel value of all-0s)"

    ^ self basicNew colorId:0

!

allColor

    "return a special color which, when used for bit-blitting will

     behave like a all-1-color (i.e. have a device-pixel value of all-1s)"

    ^ self basicNew colorId:-1

!

colorId:id

    "return a color for a specific colorid without associating it to a

     specific device. Use this only for bitmaps which want 0- or 1-color,

     or for bitblits if you want to manipulate a specific colorplane."

    id == 0 ifTrue:[

        Pseudo0 isNil ifTrue:[

            Pseudo0 := self basicNew colorId:0

        ].

        ^ Pseudo0

    ].

    id == 1 ifTrue:[

        Pseudo1 isNil ifTrue:[

            Pseudo1 := self basicNew colorId:1

        ].

        ^ Pseudo1

    ].

    id == -1 ifTrue:[

        PseudoAll isNil ifTrue:[

            PseudoAll := self basicNew colorId:-1

        ].

        ^ PseudoAll

    ].

    ^ self basicNew colorId:id

! !

!Color class methodsFor:'private'!

existingColorRed:r green:g blue:b on:aDevice

    "return a device color on aDevice with rgb values

     if there is one, nil otherwise."

    |rr rg rb|

    rr := (r * 3) rounded / 3.0.

    rg := (g * 3) rounded / 3.0.

    rb := (b * 3) rounded / 3.0.

    lobby contentsDo:[:aColor |

        (aColor device == aDevice) ifTrue:[

            aColor colorId notNil ifTrue:[

                (rr = aColor red) ifTrue:[

                    (rg = aColor green) ifTrue:[

                        (rb = aColor blue) ifTrue:[

                            ^ aColor

                        ]

                    ]

                ]

            ]

        ]

    ].

    ^ nil

!

colorNearRed:r green:g blue:b on:aDevice

    "return a device color on aDevice with rgb values

     almost matching. If there is one, nil otherwise.

     This is tried as a last chance before dithering.

     The algorithm needs rework, the color components

     should be weighted according some theory :-)"

    |bestColor minDelta diff rr rg rb|

    rr := (r * 3) rounded / 3.0.

    rg := (g * 3) rounded / 3.0.

    rb := (b * 3) rounded / 3.0.

    minDelta := 100*100*100.

    lobby contentsDo:[:aColor |

        (aColor device == aDevice) ifTrue:[

            (aColor colorId notNil) ifTrue:[

                diff := (rr - aColor red) asInteger squared

                        + (rg - aColor green) asInteger squared

                        + (rb - aColor blue) asInteger squared.

                diff < minDelta ifTrue:[

                    bestColor := aColor.

                    minDelta := diff

                ]

            ]

        ]

    ].

    "allow an error of 10% per component"

    minDelta < (100+100+100) ifTrue:[ ^ bestColor ].

    ^ nil

! !

!Color class methodsFor:'color space conversions'!

withRGBFromHue:h light:l saturation:s do:aBlock

    "compute rgb form hls, evaluate aBlock with r,g and b as arguments"

    |valueFunc s1 l1 r g b m1 m2|

    valueFunc := [:n1 :n2 :hIn |

        |hue|

        hue := hIn.

        hue > 360 ifTrue:[

            hue := hue - 360

        ] ifFalse:[

            hue < 0 ifTrue:[

                hue := hue + 360

            ].

        ].

        hue < 60 ifTrue:[

            n1 + ((n2 - n1) * hue / 60)

        ] ifFalse:[

            hue < 180 ifTrue:[

                n2

            ] ifFalse:[

                hue < 240 ifTrue:[

                    n1 + ((n2 - n1) * (240 - hue) / 60)

                ] ifFalse:[

                    n1

                ]