"

 COPYRIGHT (c) 1992 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:'red green blue device colorId ditherForm writable'

	classVariableNames:'MaxValue Lobby Cells Black White LightGrey Grey DarkGrey Pseudo0

		Pseudo1 PseudoAll Red Green Blue RetryAllocation DitherBits

		ColorAllocationFailSignal'

	poolDictionaries:''

	category:'Graphics-Support'

!

!Color class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1992 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

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

    mySelf are the red, green and blue components scaled into 0 .. MaxValue.

    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. The ditherForm can be either a depth-1 bitmap or a pixmap

    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:]

      red             <Integer>       the red component (0..MaxValue)

      green           <Integer>       the green component (0..MaxValue)

      blue            <Integer>       the blue component (0..MaxValue)

      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:]

      MaxValue        <Integer>       r/g/b components are scaled relative to this maximum

      Lobby           <Registry>      all colors in use - keeps track of already allocated

                                      colors for reuse and finalization.

                                      (dont use it: this will be moved to the device)

      Cells           <Registry>      keeps track of allocated writable color cells

                                      (dont use it: this will be moved to the device)

      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

      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)

      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

    compatibility issues:

        ST-80 seems to represent colors internally with scaled smallInteger

        components (this can be guessed from uses of

        scaledRed:scaledGreen:scaledBlue:). The main instance creation method is

        via 'ColorValue red:green:blue:', passing components in 0..1.

        In ST/X, component are internally represented as percent.

        For more compatibility (when subclassing color), these internals may

        change in the near future. For migration, a compatibility subclass

        called ColorValue is provided. 

        After the change, Color will be renamed to ColorValue and Color

        be made a subclass of ColorValue (offering the 0..100 interface for

        backward compatibility).

    [see also:]

        DeviceWorkstation 

        GraphicsContext DeviceDrawable Form Image Colormap

        Font Cursor

    [author:]

        Claus Gittinger

"

! !

!Color class methodsFor:'initialization'!

flushDeviceColors

    "unassign all colors from their device"

    "if all colors are registered in Lobby, use:"

"

    Lobby do:[:aColor |

	aColor restored.

	Lobby unregister:aColor

    ].

"

    "if only device colors are registered, use"

    self allInstances do:[:aColor |

	aColor restored

    ].

    Lobby do:[:aColor |

	Lobby unregister:aColor

    ]

!

getColors6x6x4

    "preallocates a 6x6x4 (144) colorMap and later uses those colors only.

     Doing so has the advantage that the system will never run out of colors,

     however, colors may be either inexact or dithered."

    self getColorsRed:6 green:6 blue:4

    "

     Color getColors6x6x4

    "

!

getColors6x6x5

    "preallocates a 6x6x5 (180) colorMap and later uses those colors only.

     Doing so has the advantage that the system will never run out of colors,

     however, colors may be either inexact or dithered."

    self getColorsRed:6 green:6 blue:5

    "

     Color getColors6x6x5

    "

!

getColors6x6x6

    "preallocates a 6x6x6 (196) colorMap and later uses those colors only.

     Doing so has the advantage that the system will never run out of colors,

     however, colors may be either inexact or dithered."

    self getColorsRed:6 green:6 blue:6

    "

     Color getColors6x6x6

    "

!

getColors6x7x4

    "preallocates a 6x7x4 (168) colorMap and later uses those colors only.

     Doing so has the advantage that the system will never run out of colors,

     however, colors may be either inexact or dithered."

    self getColorsRed:6 green:7 blue:4

    "

     Color getColors6x7x4

    "

    "Created: 12.6.1996 / 17:41:57 / cg"

!

getColors7x8x4

    "preallocates a 7x8x4 (224) colorMap and later uses those colors only.

     Doing so has the advantage that the system will never run out of colors,

     however, colors may be either inexact or dithered."

    self getColorsRed:7 green:8 blue:4

    "

     Color getColors7x8x4

    "

!

getColorsRed:nRed green:nGreen blue:nBlue

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

    self getColorsRed:nRed green:nGreen blue:nBlue on:Display

    "

     Color getColorsRed:2 green:2 blue:2

    "

    "Modified: 11.7.1996 / 17:58:09 / cg"

!

getColorsRed:nRed green:nGreen blue:nBlue on:aDevice

    "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 clr round

     fixColors|

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

    nR := nRed.

    nG := nGreen.

    nB := nBlue.

    dR := 100.0 / (nR - 1).

    dG := 100.0 / (nG - 1).

    dB := 100.0 / (nB - 1).

    fixColors := Array new:(nR * nG * nB).

    round := 0.

    dstIndex := 1.

    1 to:nR do:[:sR |

        red := dR * (sR - 1).

        1 to:nG do:[:sG |

            green := dG * (sG - 1).

            1 to:nB do:[:sB |

                blue := dB * (sB - 1).

                clr := (self red:red green:green blue:blue) exactOn:aDevice.

                clr isNil ifTrue:[

                    round == 0 ifTrue:[

                        'Color [info]: scavenge to reclaim colors' infoPrintCR.

                        ObjectMemory scavenge.

                        round := 1.

                        clr := (self red:red green:green blue:blue) exactOn:aDevice.

                    ].

                ].

                clr isNil ifTrue:[

                    round == 1 ifTrue:[

                        'Color [info]: collect garbage to reclaim colors' infoPrintCR.

                        ObjectMemory performLowSpaceCleanup.

                        ObjectMemory garbageCollect.

                        round := 2.

                        clr := (self red:red green:green blue:blue) exactOn:aDevice.

                   ].

                ].

                clr isNil ifTrue:[

                    ColorAllocationFailSignal raiseErrorString:'failed to allocate fix color'.

                    ^ self

                ].

                fixColors at:dstIndex put:clr.

                dstIndex := dstIndex + 1

            ]

        ]

    ].

    aDevice setFixColors:fixColors

                  numRed:nR numGreen:nG numBlue:nB

    "

     Color getColorsRed:2 green:2 blue:2 on:Display

    "

    "Created: 11.7.1996 / 17:55:32 / cg"

    "Modified: 10.1.1997 / 15:37:13 / cg"

!

getPrimaryColors

    "preallocate the primary colors.

     Doing so during early startup prevents us from running out

     of (at least those required) colors later.

     This guarantees, that at least some colors are available

     for dithering."

    self getPrimaryColorsOn:Display

    "Modified: 11.7.1996 / 18:12:17 / cg"

!

getPrimaryColorsOn:aDevice

    "preallocate the primary colors.

     Doing so during early startup prevents us from running out

     of (at least those required) colors later.

     This guarantees, that at least some colors are available

     for dithering (although, with only black, white, red, green and blue,

     dithered images look very poor)."

    |colors white black red green blue|

    (aDevice notNil and:[aDevice ditherColors isNil]) ifTrue:[

	white := (self red:100 green:100 blue:100) exactOn:aDevice.

	black := (self red:0 green:0 blue:0) exactOn:aDevice.

	aDevice hasColors ifTrue:[

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

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

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

	].

	aDevice == Display ifTrue:[

	    "/ keep those around for the main display

	    White := white.

	    Black := black.

	    Red := red.

	    Green := green.

	    Blue := blue

	].

	aDevice visualType ~~ #TrueColor ifTrue:[

	    aDevice hasColors ifTrue:[

		"preallocate some colors for dithering 

		 - 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 gray:50) exactOn:aDevice).

		colors add:white; add:black; add:red; add:green; add:blue.

		colors add:((self red:100 green:100 blue:0) exactOn:aDevice).

		colors add:((self red:100 green:0 blue:100) exactOn:aDevice).

		colors add:((self red:0 green:100 blue:100) exactOn:aDevice).

		colors := colors select:[:clr | clr notNil].

	    ].

	    aDevice hasGreyscales ifTrue:[

		aDevice hasColors ifFalse:[

		    colors := OrderedCollection new.

		    colors add:((self gray:50) exactOn:aDevice).

		    colors add:white; add:black.

		].

		colors add:((self gray:25) exactOn:aDevice).

		colors add:((self gray:33) exactOn:aDevice).

		colors add:((self gray:67) exactOn:aDevice).

		colors add:((self gray:75) exactOn:aDevice).

		colors := colors select:[:clr | clr notNil].

	    ].

	    colors notNil ifTrue:[  

		aDevice setDitherColors:(colors asArray).

	    ]

	]

    ]

    "Created: 11.7.1996 / 18:09:28 / cg"

    "Modified: 11.7.1996 / 18:27:39 / cg"

!

initialize

    "setup tracker of known colors and initialize classvars with

     heavily used colors"

    ColorAllocationFailSignal isNil ifTrue:[

	ColorAllocationFailSignal := ErrorSignal newSignalMayProceed:true.

	ColorAllocationFailSignal nameClass:self message:#colorAllocationFailSignal.

	ColorAllocationFailSignal notifierString:'color allocation failed'.

    ].

    Lobby isNil ifTrue:[

	MaxValue := 16rFFFF.

	Lobby := Registry new.

	self getPrimaryColors.

	"want to be informed when returning from snapshot"

	ObjectMemory addDependent:self.

	RetryAllocation := true.

	DitherBits := self ditherBits

    ].

    "Modified: 11.7.1996 / 18:31:39 / cg"

!

update:something with:aParameter from:changedObject

    "handle image restarts and flush any device resource handles"

    (something == #restarted) ifTrue:[

	self flushDeviceColors

    ].

    (something == #returnFromSnapshot) ifTrue:[

	self getPrimaryColors.

	Display visualType == #TrueColor ifTrue:[

	    Display releaseFixColors

	] ifFalse:[

	    Display fixColors notNil ifTrue:[

		ColorAllocationFailSignal handle:[:ex |

		    ex return

		] do:[

		    |nR nG nB|

		    nR := Display numFixRed.

		    nG := Display numFixGreen.

		    nB := Display numFixBlue.

		    Display releaseFixColors.

		    self getColorsRed:nR

				green:nG

				 blue:nB

				   on:Display

		]

	    ]

	]

    ]

    "Created: 15.6.1996 / 15:14:03 / cg"

    "Modified: 11.7.1996 / 18:03:38 / cg"

! !

!Color class methodsFor:'instance creation'!

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

    PseudoAll isNil ifTrue:[

	PseudoAll := self basicNew colorId:-1

    ].

    ^ PseudoAll

!

brightness:brightness

    "create a gray color with given brightness (0..1).

     ST-80 compatibility."

    ^ self scaledGray:(brightness * MaxValue)

!

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:[

	^ self noColor

    ].

    id == 1 ifTrue:[

	Pseudo1 isNil ifTrue:[

	    Pseudo1 := self basicNew colorId:1

	].

	^ Pseudo1