"
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' }"
MenuPanel subclass:#ColorMenu
instanceVariableNames:'enabledChannel labelsAreColored'
classVariableNames:''
poolDictionaries:''
category:'Interface-UIPainter'
!
SimpleDialog subclass:#DefineColor
instanceVariableNames:'red green blue hue light saturation colorNameHolder'
classVariableNames:''
poolDictionaries:''
privateIn:ColorMenu
!
!ColorMenu 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
"
A simple ColorMenu used by the UIPainter
[see also:]
UIPainter
ColorMenuSpec
[author:]
Claus Atzkern
"
!
examples
"
very simple example
[exBegin]
|tool top channel|
top := StandardSystemView new.
top extent:250@30.
channel := (Color red) asValue.
tool := self origin:0.0@0.0 corner:1.0@1.0 in:top.
tool model:channel.
top open.
[exEnd]
"
! !
!ColorMenu class methodsFor:'menu spec'!
colorDefinition
"color definitions used to build a color menu
"
^ #(
#( gray
gray:
#( white
veryLightGray
lightGray
gray
darkGray
veryDarkGray
black
)
)
#( red
red:
#( lightened 100 87 67 50 33)
)
#( green
green:
#( lightened 100 87 67 50 33)
)
#( blue
blue:
#( lightened 100 87 67 50 33)
)
#( cyan
cyan:
#( lightened 100 87 67 50 33)
)
#( magenta
magenta:
#( lightened 100 87 67 50 33)
)
#( yellow
yellow:
#( lightened 100 87 67 50 33)
)
)
!
colorMenu:labelAreColored value:aValue
"returns a color menu
"
|menu mainCol style e|
menu := Menu new.
style := (labelAreColored == false)
ifTrue:[#backgroundColor]
ifFalse:[#color].
self colorDefinition do:[:aSlice|
|size colOp color item smenu|
mainCol := Color perform:(aSlice at:1).
item := MenuItem labeled:(Text string:' ' emphasis:(#backgroundColor->mainCol)).
smenu := Menu new.
colOp := aSlice at:2.
(aSlice at:3) do:[:el||sitem label|
el isSymbol ifTrue:[
color := el == #lightened ifTrue:[mainCol perform:el] ifFalse:[Color perform:el].
self colorDefinition first ~~ aSlice
ifTrue: [label := (colOp upTo: $:), ' ', el]
ifFalse:[label := el].
] ifFalse:[
el isNumber ifTrue:[
color := Color perform:colOp with:el.
label := colOp, ' ', el printString.
] ifFalse:[
color := Color perform:colOp with:(el at:1) with:(el at:2) with:(el at:3).
label := ''.
colOp keywords keysAndValuesDo:[:i :c| label := label, ' ', c, ' ' , (el at:i) printString ].
]
].
e := style->color.
style == #backgroundColor ifTrue:[
color brightness < 0.5 ifTrue:[
e := Array with:e
with:(#color->Color white)
]
].
sitem := MenuItem
labeled:(Text
string:('Color ', label)
emphasis:e).
sitem argument:color.
sitem value:aValue.
smenu addItem:sitem.
].
item submenu:smenu.
item value:nil.
menu addItem:item
].
^ menu
"
(ColorMenu colorMenu:true value:nil) startUp
(ColorMenu colorMenu:false value:#aSelector:) startUp
"
! !
!ColorMenu methodsFor:'accepting'!
accept:anItem
"accept current selected item"
|item holder color|
((item := super accept:anItem) notNil and: [item nameKey ~~ #def])
ifTrue:
[
(holder := self colorHolder) == item ifTrue:
[
enabledChannel value ifTrue:[color := self color]
]
ifFalse:
[
color := item argument.
holder label:(Text string:' ' emphasis:(#backgroundColor->color)).
].
model notNil ifTrue:[model value:color]
]
! !
!ColorMenu methodsFor:'accessing'!
color
"get current color"
|firstEmphasis|
(firstEmphasis := (self colorHolder label emphasis at:1)) isAssociation ifTrue: [^firstEmphasis value].
^(firstEmphasis at: 1) value
!
color:aColor
"set current color"
|holder label|
aColor isColor ifFalse:[
enabledChannel value:false
] ifTrue:[
self
disabledRedrawDo:
[
holder := self colorHolder.
label := Text string: ' ' emphasis:(#backgroundColor->aColor).
enabledChannel value:true.
holder label:label.
model value: aColor
]
]
!
labelsAreColored: aBoolean
"sets whether labels or their backgrounds will be colored"
labelsAreColored := aBoolean ? false.
self setupMenu
! !
!ColorMenu methodsFor:'accessing-channels'!
model:aValueHolder
"set my color channel"
super model:aValueHolder.
model notNil ifTrue:[
self updateFromModel
]
! !
!ColorMenu methodsFor:'change & update'!
updateFromModel
self color:(model value)
! !
!ColorMenu methodsFor:'initialization'!
destroy
"release color channel dependency"
self model:nil.
super destroy
!
initialize
"setup menu"
super initialize.
labelsAreColored := false.
verticalLayout := false.
self fitFirstPanel:false.
enabledChannel := ValueHolder with:false.
self setupMenu.
"Modified: / 21.5.1998 / 03:07:26 / cg"
!
setupMenu
"setup menu"
|menu item|
menu := self class colorMenu:labelsAreColored value:nil.
menu itemsDo:[:el| el isButton:true].
menu
addItem:(
(MenuItem labeled:'...')
value:
[
|defineColor|
defineColor := DefineColor new color: self color.
defineColor open.
defineColor accept value ifTrue: [self color: defineColor color]
];
nameKey:#def;
isButton: true)
beforeIndex:8.
menu addItem:(MenuItem labeled:'') beforeIndex:8.
menu addItem:(MenuItem labeled:' ') beforeIndex:5.
menu addItem:(MenuItem labeled:' ') beforeIndex:2.
menu addItem:(MenuItem labeled:' ') beforeIndex:1.
item := MenuItem labeled:(Text string:' ' emphasis:(#backgroundColor->DefaultViewBackgroundColor)).
item value:#selection.
menu addItem:item beforeIndex:1.
self menu:menu.
self do:[:anItem|
(anItem submenu) notNil ifTrue:[
anItem enabled:enabledChannel.
] ifFalse:[
anItem value == #selection ifTrue:[anItem indication:enabledChannel]
ifFalse:[anItem enabled:false].
anItem nameKey == #def ifTrue:[anItem enabled:enabledChannel]
]
]
! !
!ColorMenu methodsFor:'private'!
colorHolder
"returns the item which keeps the selected color in its label
"
^ self itemAt:#selection
! !
!ColorMenu::DefineColor 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:ColorMenu::DefineColor andSelector:#windowSpec
ColorMenu::DefineColor new openInterface:#windowSpec
ColorMenu::DefineColor open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'Define Color'
#name: 'Define Color'
#min: #(#Point 340 260)
#max: #(#Point nil 260)
#bounds: #(#Rectangle 16 46 469 298)
)
#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: true
#model: #red
#orientation: #horizontal
#stop: 255
#step: 1
#backgroundColor: #(#Color 100.0 0.0 0.0)
#extent: #(#Point 225 16)
)
#(#SliderSpec
#name: 'GreenSlider'
#tabable: true
#model: #green
#orientation: #horizontal
#stop: 255
#step: 1
#backgroundColor: #(#Color 0.0 100.0 0.0)
#extent: #(#Point 225 16)
)
#(#SliderSpec
#name: 'BlueSlider'
#tabable: true
#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: true
#model: #hue
#orientation: #horizontal
#stop: 359
#step: 1
#keyboardStep: 1
#extent: #(#Point 225 16)
)
#(#SliderSpec
#name: 'Slider2'
#tabable: true
#model: #light
#orientation: #horizontal
#step: 1
#backgroundColor: #(#Color 66.9993 66.9993 66.9993)
#keyboardStep: 1
#extent: #(#Point 225 16)
)
#(#SliderSpec
#name: 'Slider3'
#tabable: true
#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
)
)
)
)
#(#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
)
)
)
)
#(#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
)
#(#LabelSpec
#label: 'Color Name:'
#name: 'Label4'
#layout: #(#LayoutFrame 0 0 190 0 106 0 212 0)
#translateLabel: true
#adjust: #right
)
)
)
)
! !
!ColorMenu::DefineColor 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
! !
!ColorMenu::DefineColor methodsFor:'actions'!
colorChanged
|box clr|
box := self componentAt: #PreviewBox.
box isNil ifTrue:[^ self "called before setup"].
clr := self color.
box backgroundColor:clr.
clr brightness < 0.5 ifTrue:[
box foregroundColor:Color white
] ifFalse:[
box foregroundColor: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
! !
!ColorMenu::DefineColor 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
! !
!ColorMenu::DefineColor 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
! !
!ColorMenu::DefineColor methodsFor:'startup / release'!
postBuildWith:aBuilder
super postBuildWith:aBuilder.
self colorChanged.
"Modified: / 6.9.1998 / 22:55:25 / cg"
! !
!ColorMenu class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/ColorMenu.st,v 1.31 2002-10-08 06:35:50 ca Exp $'
! !