"{ 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.
saturation addDependent:self.
].
^saturation
! !
!ColorEditor methodsFor:'change & update'!
update:something with:aParameter from:changedObject
(changedObject == red
or:[changedObject == green
or:[changedObject == blue]]) ifTrue:[
^ self rgbSliderChanged
].
(changedObject == hue
or:[changedObject == light
or:[changedObject == saturation]]) ifTrue:[
^ self hlsSliderChanged
].
(changedObject == colorNameHolder) ifTrue:[
^ self colorNameChanged
].
^ super update:something with:aParameter from:changedObject
! !
!ColorEditor methodsFor:'startup & release'!
postBuildWith:aBuilder
super postBuildWith:aBuilder.
self colorChanged.
"Modified: / 6.9.1998 / 22:55:25 / cg"
! !
!ColorEditor class methodsFor:'documentation'!
version
^ '$Header$'
! !