"{ Package: 'stx:libtool2' }"

SimpleDialog subclass:#ColorEditor

	instanceVariableNames:'red green blue hue light saturation colorNameHolder'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-UIPainter'

!

!ColorEditor class methodsFor:'documentation'!

documentation

"

    An edit-dialog for colors.

"

!

examples

"

                                                                                [exBegin]                                      

    |editor color|

    editor := ColorEditor new.

    editor color:(Color green).

    editor open.

    editor accepted ifTrue:[

        editor color inspect.

    ]

                                                                                [exEnd]

"

! !

!ColorEditor class methodsFor:'interface specs'!

windowSpec

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIPainter may not be able to read the specification."

    "

     UIPainter new openOnClass:ColorEditor andSelector:#windowSpec

     ColorEditor new openInterface:#windowSpec

     ColorEditor open

    "

    <resource: #canvas>

    ^ 

     #(FullSpec

        name: windowSpec

        window: 

       (WindowSpec

          label: 'Define Color'

          name: 'Define Color'

          min: (Point 340 260)

          max: (Point nil 260)

          bounds: (Rectangle 0 0 453 260)

        )

        component: 

       (SpecCollection

          collection: (

           (VerticalPanelViewSpec

              name: 'RGBLabelPanel'

              layout: (LayoutFrame 0 0 0 0 58 0 76 0)

              horizontalLayout: fit

              verticalLayout: spreadSpace

              horizontalSpace: 3

              verticalSpace: 3

              component: 

             (SpecCollection

                collection: (

                 (LabelSpec

                    label: 'Red:'

                    name: 'RedLabel'

                    translateLabel: true

                    adjust: right

                    useDefaultExtent: true

                  )

                 (LabelSpec

                    label: 'Green:'

                    name: 'GreenLabel'

                    translateLabel: true

                    adjust: right

                    useDefaultExtent: true

                  )

                 (LabelSpec

                    label: 'Blue:'

                    name: 'BlueLabel'

                    translateLabel: true

                    adjust: right

                    useDefaultExtent: true

                  )

                 )

              )

            )

           (VerticalPanelViewSpec

              name: 'RGBSliderPanel'

              layout: (LayoutFrame 62 0 0 0 -166 1 76 0)

              horizontalLayout: fit

              verticalLayout: spreadSpace

              horizontalSpace: 3

              verticalSpace: 3

              component: 

             (SpecCollection

                collection: (

                 (SliderSpec

                    name: 'RedSlider'

                    tabable: false

                    model: red

                    orientation: horizontal

                    stop: 255

                    step: 1

                    backgroundColor: (Color 100.0 0.0 0.0)

                    extent: (Point 225 16)

                  )

                 (SliderSpec

                    name: 'GreenSlider'

                    tabable: false

                    model: green

                    orientation: horizontal

                    stop: 255

                    step: 1

                    backgroundColor: (Color 0.0 100.0 0.0)

                    extent: (Point 225 16)

                  )

                 (SliderSpec

                    name: 'BlueSlider'

                    tabable: false

                    model: blue

                    orientation: horizontal

                    stop: 255

                    step: 1

                    backgroundColor: (Color 0.0 0.0 100.0)

                    extent: (Point 225 16)

                  )

                 )

              )

            )

           (VerticalPanelViewSpec

              name: 'RGBFieldPanel'

              layout: (LayoutFrame -161 1 0 0 -123 1 76 0)

              horizontalLayout: fit

              verticalLayout: spreadSpace

              horizontalSpace: 3

              verticalSpace: 3

              component: 

             (SpecCollection

                collection: (

                 (InputFieldSpec

                    name: 'RedField'

                    model: red

                    type: numberInRange

                    numChars: 3

                    minValue: 0

                    maxValue: 255

                    acceptOnPointerLeave: false

                    extent: (Point 38 20)

                  )

                 (InputFieldSpec

                    name: 'GreenField'

                    model: green

                    type: numberInRange

                    numChars: 3

                    minValue: 0

                    maxValue: 255

                    acceptOnPointerLeave: false

                    extent: (Point 38 20)

                  )

                 (InputFieldSpec

                    name: 'BlueField'

                    model: blue

                    type: numberInRange

                    numChars: 3

                    minValue: 0

                    maxValue: 255

                    acceptOnPointerLeave: false

                    extent: (Point 38 20)

                  )

                 )

              )

            )

           (VerticalPanelViewSpec

              name: 'HLSLabelPanel'

              layout: (LayoutFrame 0 0 86 0 58 0 163 0)

              horizontalLayout: fit

              verticalLayout: spreadSpace

              horizontalSpace: 3

              verticalSpace: 3

              component: 

             (SpecCollection

                collection: (

                 (LabelSpec

                    label: 'Hue:'

                    name: 'Label1'

                    translateLabel: true

                    adjust: right

                    useDefaultExtent: true

                  )

                 (LabelSpec

                    label: 'Light:'

                    name: 'Label2'

                    translateLabel: true

                    adjust: right

                    useDefaultExtent: true

                  )

                 (LabelSpec

                    label: 'Sat:'

                    name: 'Label3'

                    translateLabel: true

                    adjust: right

                    useDefaultExtent: true

                  )

                 )

              )

            )

           (VerticalPanelViewSpec

              name: 'HLSSliderPanel'

              layout: (LayoutFrame 62 0 86 0 -166 1 163 0)

              horizontalLayout: fit

              verticalLayout: spreadSpace

              horizontalSpace: 3

              verticalSpace: 3

              component: 

             (SpecCollection

                collection: (

                 (SliderSpec

                    name: 'Slider1'

                    tabable: false

                    model: hue

                    orientation: horizontal

                    stop: 359

                    step: 1

                    keyboardStep: 1

                    extent: (Point 225 16)

                  )

                 (SliderSpec

                    name: 'Slider2'

                    tabable: false

                    model: light

                    orientation: horizontal

                    step: 1

                    backgroundColor: (Color 66.9993 66.9993 66.9993)

                    keyboardStep: 1

                    extent: (Point 225 16)

                  )

                 (SliderSpec

                    name: 'Slider3'

                    tabable: false

                    model: saturation

                    orientation: horizontal

                    step: 1

                    backgroundColor: (Color 66.9993 66.9993 66.9993)

                    keyboardStep: 1

                    extent: (Point 225 16)

                  )

                 )

              )

            )

           (VerticalPanelViewSpec

              name: 'HLSFieldPanel'

              layout: (LayoutFrame -161 1 86 0 -123 1 163 0)

              horizontalLayout: fit

              verticalLayout: spreadSpace

              horizontalSpace: 3

              verticalSpace: 3

              component: 

             (SpecCollection

                collection: (

                 (InputFieldSpec

                    name: 'EntryField1'

                    model: hue

                    type: numberInRange

                    numChars: 3

                    minValue: 0

                    maxValue: 359

                    acceptOnPointerLeave: false

                    extent: (Point 38 20)

                  )

                 (InputFieldSpec

                    name: 'EntryField2'

                    model: light

                    type: numberInRange

                    numChars: 3

                    minValue: 0

                    maxValue: 100

                    acceptOnPointerLeave: false

                    extent: (Point 38 20)

                  )

                 (InputFieldSpec

                    name: 'EntryField3'

                    model: saturation

                    type: numberInRange

                    numChars: 3

                    minValue: 0

                    maxValue: 100

                    acceptOnPointerLeave: false

                    extent: (Point 38 20)

                  )

                 )

              )

            )

           (ViewSpec

              name: 'Box1'

              layout: (LayoutFrame -117 1 4 0.0 -3 1.0 -39 1.0)

              level: 1

              component: 

             (SpecCollection

                collection: (

                 (LabelSpec

                    label: 'Preview'

                    name: 'PreviewBox'

                    layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -2 1.0)

                    level: -1

                    translateLabel: true

                  )

                 )

              )

            )

           (LabelSpec

              label: 'Color Name:'

              name: 'ColorNameLabel'

              layout: (LayoutFrame 0 0 190 0 106 0 212 0)

              translateLabel: true

              adjust: right

            )

           (InputFieldSpec

              name: 'ColorNameField'

              layout: (LayoutFrame 110 0 190 0 -123 1 212 0)

              model: colorNameHolder

              immediateAccept: true

              acceptOnReturn: true

              acceptOnTab: true

              acceptOnLostFocus: true

              acceptOnPointerLeave: false

            )

           (HorizontalPanelViewSpec

              name: 'HorizontalPanel1'

              layout: (LayoutFrame 0 0.0 -32 1 0 1.0 0 1.0)

              horizontalLayout: fitSpace

              verticalLayout: centerMax

              horizontalSpace: 3

              verticalSpace: 3

              reverseOrderIfOKAtLeft: true

              component: 

             (SpecCollection

                collection: (

                 (ActionButtonSpec

                    label: 'Cancel'

                    name: 'CancelButton'

                    translateLabel: true

                    resizeForLabel: false

                    tabable: true

                    model: cancel

                    useDefaultExtent: true

                  )

                 (ActionButtonSpec

                    label: 'OK'

                    name: 'OKButton'

                    translateLabel: true

                    resizeForLabel: false

                    tabable: true

                    model: accept

                    isDefault: true

                    defaultable: true

                    useDefaultExtent: true

                  )

                 )

              )

            )

           )

        )

      )

! !

!ColorEditor methodsFor:'accessing'!

color

    ^Color redByte:(red value) greenByte:(green value) blueByte:(blue value)

!

color:aColor 

    aColor notNil ifTrue:[

        self red value:aColor redByte.

        self green value:aColor greenByte.

        self blue value:aColor blueByte.

    ]

!

colorName

    ^ colorNameHolder value

! !

!ColorEditor methodsFor:'actions'!

colorChanged

    |box clr|

    box := self componentAt: #PreviewBox.

    box isNil ifTrue:[^ self "called before setup"].

    clr := self color.

    box backgroundColor:clr.

    box foregroundColor:(clr brightness < 0.5 

                            ifTrue:[Color white] 

                            ifFalse:[Color black]).

!

colorNameChanged

    "compute rgb and hls (if possible)"

    |clr h|

    clr := Color name:colorNameHolder value ifIllegal:nil.

    clr isNil ifTrue:[

        ^ self

    ].

    red   value:clr redByte withoutNotifying:self.

    green value:clr greenByte withoutNotifying:self.

    blue  value:clr blueByte withoutNotifying:self.

    h := clr hue.

    h notNil ifTrue:[

        hue        value:(h rounded) withoutNotifying:self.

    ].

    light      value:(clr light rounded) withoutNotifying:self.

    saturation value:(clr saturation rounded) withoutNotifying:self.

    self colorChanged

!

hlsSliderChanged

    "compute rgb"

    Color withRGBFromHue:hue value light:light value saturation:saturation value do:[:r :g :b |

        red    value:(r * 255 / 100) rounded withoutNotifying:self.

        green  value:(g * 255 / 100) rounded withoutNotifying:self.

        blue   value:(b * 255 / 100) rounded withoutNotifying:self.

    ].

    colorNameHolder value:'' withoutNotifying:self.

    self colorChanged

!

rgbSliderChanged

    "compute hls"

    |r g b|

    r := self red value.

    g := self green value.

    b := self blue value.

    Color withHLSFromRed:(r * 100 / 255) green:(g * 100 / 255) blue:(b * 100 / 255) do:[:h :l :s |

        h isNil ifTrue:[

            "/ achromatic

        ] ifFalse:[

            self hue    value:(h rounded) withoutNotifying:self.

        ].

        self light      value:(l rounded) withoutNotifying:self.

        self saturation value:(s rounded) withoutNotifying:self.

    ].

    self colorNameHolder value:'' withoutNotifying:self.

    self colorChanged

! !

!ColorEditor methodsFor:'aspects'!

blue

    blue isNil ifTrue:[

        blue := 0 asValue.

        blue addDependent:self.

    ].

    ^blue

!

colorNameHolder

    colorNameHolder isNil ifTrue:[

        colorNameHolder := '' asValue.

        colorNameHolder addDependent:self.

    ].

    ^colorNameHolder

!

green

    green isNil ifTrue:[

        green := 0 asValue.

        green addDependent:self.

    ].

    ^green

!

hue

    hue isNil ifTrue:[

        hue := 0 asValue.

        hue addDependent:self.

    ].

    ^hue

!

light

    light isNil ifTrue:[

        light := 0 asValue.

        light addDependent:self.

    ].

    ^light

!

red

    red isNil ifTrue:[

        red := 0 asValue.

        red addDependent:self.

    ].

    ^red

!

saturation

    saturation isNil ifTrue:[

        saturation := 0 asValue.