"
 COPYRIGHT (c) 1995 by eXept Software AG
              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:libtool2' }"

SimpleDialog subclass:#ColorEditDialog
	instanceVariableNames:'red green blue hue light saturation colorNameHolder
		htmlColorNameHolder previewBox'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-UIPainter'
!

!ColorEditDialog class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1995 by eXept Software AG
              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
"
    An edit-dialog for colors.
"
!

examples
"
                                                                                [exBegin]                                      
    |editor color|

    editor := ColorEditDialog new.
    editor color:(Color green).
    editor open.
    editor accepted ifTrue:[
        editor color inspect.
    ]
                                                                                [exEnd]
"
! !

!ColorEditDialog class methodsFor:'help specs'!

flyByHelpSpec
    "This resource specification was automatically generated
     by the UIHelpTool of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIHelpTool may not be able to read the specification."

    "
     UIHelpTool openOnClass:ColorEditDialog    
    "

    <resource: #help>

    ^ super flyByHelpSpec addPairsFrom:#(

#pickColor
'Pick a Color from the Screen'

)
!

helpSpec
    "This resource specification was automatically generated
     by the UIHelpTool of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIHelpTool may not be able to read the specification."

    "
     UIHelpTool openOnClass:ColorEditDialog    
    "

    <resource: #help>

    ^ super helpSpec addPairsFrom:#(

#copyToClipboard
'Copy the color to the clipboard'

#hlsMixer
'Mix color from hls (hue-light-saturation) components'

#pasteFromClipboard
'Paste color from the Clipboard'

#rgbMixer
'Mix color from rgb (red-green-blue) components'

)
! !

!ColorEditDialog class methodsFor:'image specs'!

pickColorIcon
    ^ ToolbarIconLibrary pipette16x16Icon
! !

!ColorEditDialog 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:ColorEditDialog andSelector:#windowSpec
     ColorEditDialog new openInterface:#windowSpec
     ColorEditDialog open
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: windowSpec
        window: 
       (WindowSpec
          label: 'Define Color'
          name: 'Define Color'
          min: (Point 440 300)
          max: (Point 440 300)
          bounds: (Rectangle 0 0 440 300)
        )
        component: 
       (SpecCollection
          collection: (
           (VerticalPanelViewSpec
              name: 'RGBLabelPanel'
              layout: (LayoutFrame 0 0 0 0 70 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 70 0 0 0 -177 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 193 16)
                  )
                 (SliderSpec
                    name: 'GreenSlider'
                    tabable: false
                    model: green
                    orientation: horizontal
                    stop: 255
                    step: 1
                    backgroundColor: (Color 0.0 100.0 0.0)
                    extent: (Point 193 16)
                  )
                 (SliderSpec
                    name: 'BlueSlider'
                    tabable: false
                    model: blue
                    orientation: horizontal
                    stop: 255
                    step: 1
                    backgroundColor: (Color 0.0 0.0 100.0)
                    extent: (Point 193 16)
                  )
                 )
               
              )
            )
           (VerticalPanelViewSpec
              name: 'RGBFieldPanel'
              layout: (LayoutFrame -173 1 0 0 -143 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 30 20)
                  )
                 (InputFieldSpec
                    name: 'GreenField'
                    model: green
                    type: numberInRange
                    numChars: 3
                    minValue: 0
                    maxValue: 255
                    acceptOnPointerLeave: false
                    extent: (Point 30 20)
                  )
                 (InputFieldSpec
                    name: 'BlueField'
                    model: blue
                    type: numberInRange
                    numChars: 3
                    minValue: 0
                    maxValue: 255
                    acceptOnPointerLeave: false
                    extent: (Point 30 20)
                  )
                 )
               
              )
            )
           (VerticalPanelViewSpec
              name: 'RGBFieldPanelHex'
              layout: (LayoutFrame -141 1 0 0 -119 1 76 0)
              horizontalLayout: fit
              verticalLayout: spreadSpace
              horizontalSpace: 3
              verticalSpace: 3
              component: 
             (SpecCollection
                collection: (
                 (InputFieldSpec
                    name: 'EntryField4'
                    model: red
                    type: hexIntegerInRange
                    numChars: 3
                    minValue: 0
                    maxValue: 255
                    acceptOnPointerLeave: false
                    extent: (Point 22 20)
                  )
                 (InputFieldSpec
                    name: 'EntryField5'
                    model: green
                    type: hexIntegerInRange
                    numChars: 3
                    minValue: 0
                    maxValue: 255
                    acceptOnPointerLeave: false
                    extent: (Point 22 20)
                  )
                 (InputFieldSpec
                    name: 'EntryField6'
                    model: blue
                    type: hexIntegerInRange
                    numChars: 3
                    minValue: 0
                    maxValue: 255
                    acceptOnPointerLeave: false
                    extent: (Point 22 20)
                  )
                 )
               
              )
            )
           (VerticalPanelViewSpec
              name: 'HLSLabelPanel'
              layout: (LayoutFrame 0 0 86 0 70 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: 'Saturation:'
                    name: 'Label3'
                    translateLabel: true
                    adjust: right
                    useDefaultExtent: true
                  )
                 )
               
              )
            )
           (VerticalPanelViewSpec
              name: 'HLSSliderPanel'
              layout: (LayoutFrame 70 0 86 0 -177 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 193 16)
                  )
                 (SliderSpec
                    name: 'Slider2'
                    tabable: false
                    model: light
                    orientation: horizontal
                    step: 1
                    backgroundColor: (Color 66.999313344015 66.999313344015 66.999313344015)
                    keyboardStep: 1
                    extent: (Point 193 16)
                  )
                 (SliderSpec
                    name: 'Slider3'
                    tabable: false
                    model: saturation
                    orientation: horizontal
                    step: 1
                    backgroundColor: (Color 66.999313344015 66.999313344015 66.999313344015)
                    keyboardStep: 1
                    extent: (Point 193 16)
                  )
                 )
               
              )
            )
           (VerticalPanelViewSpec
              name: 'HLSFieldPanel'
              layout: (LayoutFrame -173 1 86 0 -143 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 30 20)
                  )
                 (InputFieldSpec
                    name: 'EntryField2'
                    model: light
                    type: numberInRange
                    numChars: 3
                    minValue: 0
                    maxValue: 100
                    acceptOnPointerLeave: false
                    extent: (Point 30 20)
                  )
                 (InputFieldSpec
                    name: 'EntryField3'
                    model: saturation
                    type: numberInRange
                    numChars: 3
                    minValue: 0
                    maxValue: 100
                    acceptOnPointerLeave: false
                    extent: (Point 30 20)
                  )
                 )
               
              )
            )
           (ViewSpec
              name: 'PreviewBoxFrame'
              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
                    postBuildCallback: postBuildPreviewBox:
                  )
                 )
               
              )
            )
           (LabelSpec
              label: 'Color Name:'
              name: 'ColorNameLabel'
              layout: (LayoutFrame 0 0 176 0 106 0 198 0)
              translateLabel: true
              adjust: right
            )
           (InputFieldSpec
              name: 'ColorNameField'
              layout: (LayoutFrame 108 0 176 0 -162 1 198 0)
              model: colorNameHolder
              immediateAccept: false
              acceptOnReturn: true
              acceptOnTab: true
              acceptOnLostFocus: true
              acceptOnPointerLeave: true
            )
           (LabelSpec
              label: 'HTML Color Name:'
              name: 'HTMLColorNameLabel'
              layout: (LayoutFrame 4 0 204 0 110 0 226 0)
              translateLabel: true
              adjust: right
            )
           (InputFieldSpec
              name: 'MLHTColorNameFieldField'
              layout: (LayoutFrame 108 0 204 0 -162 1 226 0)
              model: htmlColorNameHolder
              immediateAccept: false
              acceptOnReturn: true
              acceptOnTab: true
              acceptOnLostFocus: true
              acceptOnPointerLeave: true
            )
           (ActionButtonSpec
              label: 'Copy Color'
              name: 'CopyColor'
              layout: (LayoutFrame 12 0 236 0 100 0 258 0)
              activeHelpKey: hlsMixer
              translateLabel: true
              resizeForLabel: true
              tabable: true
              model: copyColor
            )
           (ActionButtonSpec
              label: 'Paste Color'
              name: 'PasteColor'
              layout: (LayoutFrame 108 0 236 0 196 0 258 0)
              translateLabel: true
              resizeForLabel: true
              tabable: true
              model: pasteColor
            )
           (ActionButtonSpec
              label: 'pickColorIcon'
              name: 'Button1'
              layout: (LayoutFrame 285 0 236 0 312 0 263 0)
              activeHelpKey: pickColor
              hasCharacterOrientedLabel: false
              translateLabel: true
              resizeForLabel: true
              tabable: true
              model: pickColor
            )
           (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
                  )
                 )
               
              )
            )
           )
         
        )
      )
! !

!ColorEditDialog class methodsFor:'startup'!

openOn:aColor
    ^ self new
        color:aColor;
        open;
        yourself

    "
     self openOn:Color red
    "
! !

!ColorEditDialog methodsFor:'accessing'!

color
    |colorName|

    colorName := self colorName.
    colorName notEmptyOrNil ifTrue:[
        "/ ^ Color name:(colorName asSymbol)
        ^ colorName asSymbol
    ].
    ^ Color redByte:(red value) greenByte:(green value) blueByte:(blue value)
!

color:aColor
    aColor isNil ifTrue:[
        ^ self
    ].

    aColor isSymbol ifTrue:[
        self colorNameHolder value:aColor
    ] ifFalse:[
        self red value:aColor redByte.
        self green value:aColor greenByte.
        self blue value:aColor blueByte.
    ]
!

colorName
    ^ colorNameHolder value
!

htmlColorName
    ^ htmlColorNameHolder value
! !

!ColorEditDialog methodsFor:'actions'!

colorChanged
    |clr|

    clr := self color.
    clr isColor ifTrue:[
        "not a symbol"
        self setPreview:clr.
        self htmlColorNameHolder value:(clr htmlPrintString) withoutNotifying:self.
    ].
!

colorChangedTo:clr
    "compute rgb and hls (if possible)"

    |h|

    self red   value:clr redByte withoutNotifying:self.
    self green value:clr greenByte withoutNotifying:self.
    self blue  value:clr blueByte withoutNotifying:self.

    h := clr hue.
    h notNil ifTrue:[
        self hue        value:(h rounded) withoutNotifying:self.
    ].
    self light      value:(clr light rounded) withoutNotifying:self.
    self saturation value:(clr saturation rounded) withoutNotifying:self.

    self colorChanged
!

colorNameChanged
    "compute rgb and hls (if possible)"

    |clr|

    clr := Color name:colorNameHolder value ifIllegal:nil.
    clr isNil ifTrue:[
        ^ self
    ].
    self colorChangedTo:clr.
!

copyColor
    self window setClipboardObject:self color
!

copyColorName
    self window setClipboardText:self htmlColorName
!

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
!

htmlColorNameChanged
    "compute rgb and hls (if possible)"

    |clr|

    htmlColorNameHolder value isEmptyOrNil ifTrue:[
        ^ self.
    ].

    clr := Color rgbValue:(Integer 
                                readFrom:(htmlColorNameHolder value copyFrom:2)
                                radix:16
                                onError:nil).
    clr isNil ifTrue:[
        ^ self
    ].
    self colorNameHolder value:'' withoutNotifying:self.
    self colorChangedTo:clr.
!

pasteColor
    |copyBufferColor|

    copyBufferColor := self window getClipboardObject.
    copyBufferColor isColor ifFalse:[
        UserPreferences current beepInEditor ifTrue:[                
            self window beep.
        ].
        ^ self
    ].
    self color:copyBufferColor
!

pickColor
    |color|

    color := Color fromUserWithFeedBack:[:clr | self setPreview:clr].
    color notNil ifTrue:[
        self color:color.
    ]
!

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
!

setPreview:color
    previewBox isNil ifTrue:[^ self "called before setup"].

    previewBox backgroundColor:color.
    previewBox foregroundColor:(color brightness < 0.5 
                            ifTrue:[Color white] 
                            ifFalse:[Color black]).
! !

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

htmlColorNameHolder
    htmlColorNameHolder isNil ifTrue:[
        htmlColorNameHolder := '' asValue.
        htmlColorNameHolder addDependent:self.
    ].
    ^htmlColorNameHolder
!

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.
        saturation addDependent:self.
    ].
    ^saturation
! !

!ColorEditDialog methodsFor:'change & update'!

update:something with:aParameter from:changedObject
    (changedObject == red
    or:[changedObject == green
    or:[changedObject == blue]]) ifTrue:[
        self rgbSliderChanged.
        ^ self
    ].

    (changedObject == hue
    or:[changedObject == light
    or:[changedObject == saturation]]) ifTrue:[
        self hlsSliderChanged.
        ^ self
    ].

    (changedObject == colorNameHolder) ifTrue:[
        self colorNameChanged.
        ^ self
    ].
    (changedObject == htmlColorNameHolder) ifTrue:[
        self htmlColorNameChanged.
        ^ self
    ].

    super update:something with:aParameter from:changedObject
! !

!ColorEditDialog methodsFor:'startup & release'!

postBuildPreviewBox:aView
    previewBox := aView
!

postBuildWith:aBuilder
    super postBuildWith:aBuilder.
    self colorChanged.

    "Modified: / 6.9.1998 / 22:55:25 / cg"
! !

!ColorEditDialog class methodsFor:'documentation'!

version
    ^ '$Header$'
! !