"

 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.

"

"{ Package: 'stx:libview' }"

Object subclass:#Color

	instanceVariableNames:'red green blue device colorId ditherForm replacementColor

		writable'

	classVariableNames:'MaxValue Cells Black White LightGrey Grey DarkGrey Pseudo0

		Pseudo1 PseudoAll Red Green Blue RetryAllocation DitherBits

		ColorErrorSignal ColorAllocationFailSignal InvalidColorNameSignal

		StandardColorValues Transparent'

	poolDictionaries:''

	category:'Graphics-Support'

!

Object subclass:#DeviceColorHandle

	instanceVariableNames:'device colorId'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Color

!

!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'!

allocateColorsIn:aColorVector on:aDevice

    "{ Pragma: +optSpace }"

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

    |clr round

     devClr|

    round := 0.

    1 to:aColorVector size do:[:dstIndex |

	clr := aColorVector at:dstIndex.

	devClr := clr exactOn:aDevice.

	devClr isNil ifTrue:[

	    round == 0 ifTrue:[

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

		ObjectMemory scavenge.

		round := 1.

		devClr := clr exactOn:aDevice.

	    ].

	].

	devClr isNil ifTrue:[

	    round == 1 ifTrue:[

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

		ObjectMemory performLowSpaceCleanup.

		ObjectMemory garbageCollect; finalize.

		round := 2.

		devClr := clr exactOn:aDevice.

	   ].

	].

	devClr isNil ifTrue:[

	    ColorAllocationFailSignal raiseErrorString:'failed to allocate fix color'.

	    ^ self

	].

	aColorVector at:dstIndex put:devClr.

    ].

!

colorCubeWithRed:nRed green:nGreen blue:nBlue

    "{ Pragma: +optSpace }"

    |nR "{Class: SmallInteger }"

     nG "{Class: SmallInteger }"

     nB "{Class: SmallInteger }"

     dR dG dB red green blue dstIndex clr round

     colorCube|

    nR := nRed.

    nG := nGreen.

    nB := nBlue.

    dR := 100.0 / (nR - 1).

    dG := 100.0 / (nG - 1).

    dB := 100.0 / (nB - 1).

    colorCube := 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.

		colorCube at:dstIndex put:clr.

		dstIndex := dstIndex + 1

	    ]

	]

    ].

    ^ colorCube

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

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

!

flushDeviceColors

    "unassign all colors from their device"

    self allInstances do:[:aColor |

	aColor restored

    ].

    "Modified: 24.2.1997 / 18:27:06 / cg"

!

flushDeviceColorsFor:aDevice

    self allInstancesDo:[:aColor |

	aColor device == aDevice ifTrue:[

	    aColor restored

	]

    ]

!

getColors6x6x4

    "{ Pragma: +optSpace }"

    "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

    "{ Pragma: +optSpace }"

    "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

    "{ Pragma: +optSpace }"

    "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

    "{ Pragma: +optSpace }"

    "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

    "{ Pragma: +optSpace }"

    "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

    "{ Pragma: +optSpace }"

    "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:Screen current

    "

     Color getColorsRed:2 green:2 blue:2

    "

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

!

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

    "{ Pragma: +optSpace }"

    "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 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 := self colorCubeWithRed:nRed green:nGreen blue:nBlue.

    self allocateColorsIn:fixColors on:aDevice.

    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"

!

getGrayColors:nGray on:aDevice

    "{ Pragma: +optSpace }"

    "preallocates nGray gray colors 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."

    |nG "{Class: SmallInteger }"

     d fixGrayColors|

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

    nG := nGray.

    d := 100.0 / (nG - 1).

    fixGrayColors := self grayColorVector:nGray.

    self allocateColorsIn:fixGrayColors on:aDevice.

    aDevice setFixGrayColors:fixGrayColors

    "

     Color getGrayColors:16 on:Display

    "

    "Created: 23.6.1997 / 15:29:50 / cg"

!

getPrimaryColorsOn:aDevice

    "{ Pragma: +optSpace }"

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

     lastPix "{ Class: SmallInteger }" |

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

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

	white colorId isNil ifTrue:[

	    'Color [warning]: cannot allocate white color' errorPrintCR.

	].

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

	black colorId isNil ifTrue:[

	    'Color [warning]: cannot allocate black color' errorPrintCR.

	].

	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.

	    (red isNil

	    or:[green isNil

	    or:[blue isNil

	    or:[red colorId isNil

	    or:[green colorId isNil

	    or:[blue colorId isNil]]]]]) ifTrue:[

		'Color [warning]: cannot allocate primary color(s)' errorPrintCR.

		dDepth := aDevice depth.

		((dDepth >= 4) and:[dDepth <= 8]) ifTrue:[

		    "/

		    "/ see what we have ...

		    "/

		    lastPix := (1 bitShift:dDepth) - 1.

		    0 to:lastPix do:[:pixel |

			colors := OrderedCollection new.

			aDevice getRGBFrom:pixel into:[:r :g :b |

			    colors add:((Color red:r green:g blue:b) exactOn:aDevice).

			]

		    ].

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

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

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

		] ifFalse:[

		    aDevice hasColors:false.

		    aDevice hasGrayscales:false.

		    red := green := blue := nil.

		]

	    ]

	].

	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.

		clr := (self gray:50) exactOn:aDevice.

		(clr notNil and:[clr colorId notNil]) ifTrue:[

		    colors add:clr

		].

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

	    ].

	    aDevice hasGrayscales ifTrue:[