"{ Encoding: utf8 }"

"

 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' }"

"{ NameSpace: Smalltalk }"

Object subclass:#Color

	instanceVariableNames:'red green blue device colorId ditherForm replacementColor

		writable'

	classVariableNames:'Black Blue Cells ColorAllocationFailSignal ColorErrorSignal

		DarkGrey DitherBits Green Grey InvalidColorNameSignal LightGrey

		MaxValue Orange Pseudo0 Pseudo1 PseudoAll Red RetryAllocation

		StandardColorValues Transparent White Yellow'

	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.

    The main info I keep in mySelf are the red, green and blue components scaled into 0 .. MaxValue.

    A device specific color can be acquired by sending a color the 'onDevice:aDevice' message,

    which will return a color with the same r/g/b values as the receiver but with a specific

    colorID for that device (which may or may not imply a colormap slot allocation on that device).

    A device-specific color index (i.e. palette-ID) is then found in the newly allocated color's colorID slot.

    Most of the device dependent coding was to support limited graphics devices (non truecolor, eg. palette)

    in a transparent way. This was required at that time (late 80's, early 90's),

    but is now almost obsolete, as these days, virtually any graphic systems supports true colors.

    It is arguably, if that stuff should remain here, or if we should simply give up support

    for old VGA-like displays 

    (actually, there are still such limited displays around, for example in the embedded area.

     So we will leave that support in for another few years ;-) ).

    On such limited devices, 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 approximate 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.

                                      (don't use it: this will be moved to the device)

      Cells           <Registry>      keeps track of allocated writable color cells

                                      (don't 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, rgb components are typically 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'!

initialize

    "setup tracker of known colors and initialize classvars with

     heavily used colors"

    ColorErrorSignal isNil ifTrue:[

	ColorErrorSignal := Error newSignalMayProceed:true.

	ColorErrorSignal nameClass:self message:#colorErrorSignal.

	ColorErrorSignal notifierString:'color error'.

	ColorAllocationFailSignal := ColorErrorSignal newSignalMayProceed:true.

	ColorAllocationFailSignal nameClass:self message:#colorAllocationFailSignal.

	ColorAllocationFailSignal notifierString:'color allocation failed'.

	InvalidColorNameSignal := ColorErrorSignal newSignalMayProceed:true.

	InvalidColorNameSignal nameClass:self message:#invalidColorNameSignal.

	InvalidColorNameSignal notifierString:'invalid color name'.

	MaxValue := 16rFFFF.

	"want to be informed when returning from snapshot"

	ObjectMemory addDependent:self.

	RetryAllocation := true.

	DitherBits := self ditherBits.

	self initializeStandardColorNames.

    ].

    "

     Color initialize

    "

    "Modified: / 30.9.1998 / 21:56:50 / cg"

!

initializeStandardColorNames

    "{ Pragma: +optSpace }"

    "setup standard colors"

    StandardColorValues := Dictionary new.

    #(

		'red'     (16rFFFF 16r0000 16r0000)

		'green'   (16r0000 16rFFFF 16r0000)

		'blue'    (16r0000 16r0000 16rFFFF)

		'yellow'  (16rFFFF 16rFFFF 16r0000)

		'magenta' (16rFFFF 16r0000 16rFFFF)

		'cyan'    (16r0000 16rFFFF 16rFFFF)

		'white'   (16rFFFF 16rFFFF 16rFFFF)

		'black'   (16r0000 16r0000 16r0000)

		'olive'   (16r7FFF 16r7FFF 16r0000)

		'teal'    (16r0000 16r7FFF 16r7FFF)

		'silver'  (16r6666 16r6666 16r6666)

		'lime'    (16r3333 16rFFFF 16r0000)

		'fuchsia' (16r9999 16r07ae 16rFFFF)

		'aqua'    (16r199a 16rFFFF 16rFFFF)

    ) pairWiseDo:[:name :value |

	StandardColorValues at:name put:value

    ].

    "

     Color initializeStandardColorNames

    "

    "Modified: 6.3.1997 / 02:28:58 / cg"

!

update:something with:aParameter from:changedObject

    "handle image restarts and flush any device resource handles"

    (something == #returnFromSnapshot) ifTrue:[

	Display notNil ifTrue:[

	    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: 24.2.1997 / 22:08:05 / 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 setColorId:-1

    ].

    ^ PseudoAll

    "Modified: 17.1.1997 / 00:05:36 / cg"

!

bgrValue:bgr

    "return a color from a 24bit BGR value (intentionally not RGB);

     The value is composed of b<<16 + g<<8 + r.

     (this byte-order is sometimes encountered with windows systems (progs)"

    |r g b|

    b := (bgr bitShift:-16) bitAnd:16rFF.

    g := (bgr bitShift:-8) bitAnd:16rFF.

    r := (bgr) bitAnd:16rFF.

    ^ self redByte:r greenByte:g blueByte:b

!

blue: blue

    "return a color from blue value;

     the argument green is interpreted as percent (0..100)"

    ^ here

	scaledRed:0 scaledGreen:0 scaledBlue:(blue * MaxValue // 100)

    "

     (Color blue:50) inspect

    "

!

brightness:brightness

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

     ST-80 compatibility."

    ^ self scaledGray:(brightness * MaxValue) rounded

!

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 setColorId:1

	].

	^ Pseudo1

    ].

    id == -1 ifTrue:[

	^ self allColor

    ].

    ^ self basicNew setColorId:id

    "Modified: 24.2.1997 / 18:16:30 / cg"

!

cyan:c magenta:m yellow:y

    "return a color from cyan, magenta and yellow values.

     all values are given in percent (0..100)"

    ^ self

	redPercent:(100 - c)

	greenPercent:(100 - m)

	bluePercent:(100 - y)

    "

     Color cyan:100 magenta:0 yellow:0      - cyan

     Color cyan:100 magenta:100 yellow:0    - blue

     Color cyan:100 magenta:0 yellow:100    - green

     Color cyan:100 magenta:100 yellow:100  - black

    "

    "Modified: 11.6.1996 / 18:29:15 / cg"

!

cyan:c magenta:m yellow:y black:k

    "return a color from cyan, magenta, yellow and black values.

     all values are given in percent (0..100).

     The value returned here is questionable.

     TODO: we loose information about one component here,

     and should actually return an instance of CMYK color, which keeps this

     information internally for later use (when saving)."

    |scale r g b|

    "/ mhmh - how should we scale black into the components ?

    r := (100 - c).

    g := (100 - m).

    b := (100 - y).

    k ~~ 0 ifTrue:[

	"/ more black - darker

	scale := (100-k) max:0.

	scale := scale / 100.

	r := r * scale.

	g := g * scale.

	b := b * scale.

    ].

    ^ self redPercent:r greenPercent:g bluePercent:b

    "

     Color cyan:100 magenta:0 yellow:0 black:0      - cyan

     Color cyan:100 magenta:0 yellow:0 black:50     - cyan darkened

     Color cyan:100 magenta:50 yellow:50 black:0    - cyan darkened

     Color cyan:0 magenta:0 yellow:0 black:100      - black

    "

    "Modified: 11.6.1996 / 18:29:15 / cg"

!

dither:fraction between:color1 and:color2 on:aDevice

    "create a dithered Color which dithers between color1 and color2.

     Fraction must be 0..1, color1 and color2 must be real (i.e. undithered)

     colors.

     Useful, if you explicitely want a dithered color

     (for example, to not use up too many colors, or for special effects)"

    |newColor form c1 c2|

    "/ both must be true device colors

    c1 := color1 exactOn:aDevice.

    c2 := color2 exactOn:aDevice.

    (c1 isNil or:[c2 isNil]) ifTrue:[

	'Color [warning]: monoDither failed - no real colors given' errorPrintCR.

	^ nil

    ].

    self

	monoDitherFor:fraction

	between:c1

	and:c2

	on:aDevice

	into:[:c :f | newColor := c. form := f].

    newColor notNil ifTrue:[^ newColor].

    form isNil ifTrue:[

	"/ cannot happen

	'Color [warning]: monoDither failed' errorPrintCR.

	^ nil

    ].

    newColor := self basicNew

			setScaledRed:nil

			scaledGreen:nil

			scaledBlue:nil

			device:aDevice.

    newColor setDitherForm:form.

    newColor setDevice:aDevice colorId:nil.

    ^ newColor

    "

     (Color dither:0.25 between:Color red and:Color yellow on:Display) inspect

     (Color dither:0.5 between:Color red and:Color yellow on:Display) inspect

     (Color dither:0.75 between:Color red and:Color yellow on:Display) inspect

    "

    "Created: 3.5.1997 / 10:54:32 / cg"

    "Modified: 3.5.1997 / 11:10:51 / cg"

!

dithered:fraction between:color1 and:color2 on:aDevice

    "create a dithered Color which dithers between color1 and color2.

     Fraction must be 0..1, color1 and color2 must be real (i.e. undithered)

     colors.

     Useful, if you explicitely want a dithered color

     (for example, to not use up too many colors, or for special effects)"

    |newColor form c1 c2|

    "/ both must be true device colors

    c1 := color1 exactOn:aDevice.

    c2 := color2 exactOn:aDevice.

    (c1 isNil or:[c2 isNil]) ifTrue:[

        'Color [warning]: monoDither failed - no real colors given' errorPrintCR.

        ^ nil

    ].

    self

        monoDitherFor:fraction

        between:c1

        and:c2

        on:aDevice

        into:[:c :f | newColor := c. form := f].

    newColor notNil ifTrue:[^ newColor].

    form isNil ifTrue:[

        "/ cannot happen

        'Color [warning]: monoDither failed' errorPrintCR.

        ^ nil

    ].

    newColor := self basicNew

                        setScaledRed:nil

                        scaledGreen:nil

                        scaledBlue:nil

                        device:aDevice.

    newColor setDitherForm:form.

    newColor setDevice:aDevice colorId:nil.

    ^ newColor

    "

     |c|