hg/stx-libwidg2: ColorMenu.st@1a51da8de402 (annotated)

422 b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	1	"
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	2	COPYRIGHT (c) 1995 by eXept Software AG
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	3	All Rights Reserved
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	4
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	5	This software is furnished under a license and may be used
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	6	only in accordance with the terms of that license and with the
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	7	inclusion of the above copyright notice. This software may not
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	8	be provided or otherwise made available to, or used by, any
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	9	other person. No title to or ownership of the software is
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	10	hereby transferred.
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	11	"
2935 e3fa9d1a7a64 Moved ColorMenu and FontMenu from libtool2 Stefan Vogel <sv@exept.de> parents: 2704 diff changeset	12	"{ Package: 'stx:libwidg2' }"
1803 ad801646be62 category change Claus Gittinger <cg@exept.de> parents: 1676 diff changeset	13
412 a8ad581658ec intitial checkin ca parents: diff changeset	14	MenuPanel subclass:#ColorMenu
2183 5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	15	instanceVariableNames:'enabledChannel labelsAreColored'
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	16	classVariableNames:'ColorMenuSpec RecentlyUsedColors'
412 a8ad581658ec intitial checkin ca parents: diff changeset	17	poolDictionaries:''
a8ad581658ec intitial checkin ca parents: diff changeset	18	category:'Interface-UIPainter'
a8ad581658ec intitial checkin ca parents: diff changeset	19	!
a8ad581658ec intitial checkin ca parents: diff changeset	20
a8ad581658ec intitial checkin ca parents: diff changeset	21	!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin ca parents: diff changeset	22
422 b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	23	copyright
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	24	"
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	25	COPYRIGHT (c) 1995 by eXept Software AG
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	26	All Rights Reserved
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	27
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	28	This software is furnished under a license and may be used
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	29	only in accordance with the terms of that license and with the
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	30	inclusion of the above copyright notice. This software may not
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	31	be provided or otherwise made available to, or used by, any
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	32	other person. No title to or ownership of the software is
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	33	hereby transferred.
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	34	"
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	35
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	36
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	37	!
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	38
412 a8ad581658ec intitial checkin ca parents: diff changeset	39	documentation
a8ad581658ec intitial checkin ca parents: diff changeset	40	"
2183 5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	41	A simple ColorMenu used by the UIPainter
412 a8ad581658ec intitial checkin ca parents: diff changeset	42
a8ad581658ec intitial checkin ca parents: diff changeset	43	[see also:]
a8ad581658ec intitial checkin ca parents: diff changeset	44	UIPainter
a8ad581658ec intitial checkin ca parents: diff changeset	45	ColorMenuSpec
422 b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	46
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	47	[author:]
b28cfebfef40 added copyrights Claus Gittinger <cg@exept.de> parents: 412 diff changeset	48	Claus Atzkern
412 a8ad581658ec intitial checkin ca parents: diff changeset	49	"
a8ad581658ec intitial checkin ca parents: diff changeset	50	!
a8ad581658ec intitial checkin ca parents: diff changeset	51
a8ad581658ec intitial checkin ca parents: diff changeset	52	examples
a8ad581658ec intitial checkin ca parents: diff changeset	53	"
2183 5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	54	very simple example
412 a8ad581658ec intitial checkin ca parents: diff changeset	55	[exBegin]
a8ad581658ec intitial checkin ca parents: diff changeset	56	\|tool top channel\|
a8ad581658ec intitial checkin ca parents: diff changeset	57
a8ad581658ec intitial checkin ca parents: diff changeset	58	top := StandardSystemView new.
a8ad581658ec intitial checkin ca parents: diff changeset	59	top extent:250@30.
2183 5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	60
412 a8ad581658ec intitial checkin ca parents: diff changeset	61	channel := (Color red) asValue.
a8ad581658ec intitial checkin ca parents: diff changeset	62	tool := self origin:0.0@0.0 corner:1.0@1.0 in:top.
a8ad581658ec intitial checkin ca parents: diff changeset	63	tool model:channel.
2183 5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	64
412 a8ad581658ec intitial checkin ca parents: diff changeset	65	top open.
a8ad581658ec intitial checkin ca parents: diff changeset	66	[exEnd]
a8ad581658ec intitial checkin ca parents: diff changeset	67	"
a8ad581658ec intitial checkin ca parents: diff changeset	68	! !
a8ad581658ec intitial checkin ca parents: diff changeset	69
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	70	!ColorMenu class methodsFor:'instance creation'!
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	71
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	72	colorMenu:labelAreColored value:aValue
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	73	"returns a color menu
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	74	"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	75	\|menu\|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	76
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	77	menu := Menu new.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	78
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	79	self colorMenu itemsDo:[:el\|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	80	menu addItem:(self resolveMenuItem:el value:aValue labelAreColored:labelAreColored).
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	81	].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	82	^ menu
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	83
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	84	"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	85	(ColorMenu colorMenu:true value:nil) startUp
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	86	(ColorMenu colorMenu:false value:#aSelector:) startUp
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	87	"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	88	! !
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	89
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	90	!ColorMenu class methodsFor:'adding & removing user defined items'!
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	91
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	92	addUserDefinedColors:aColors labels:labelsOrNil title:aTitle
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	93	"add user colors to ALL colormenus"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	94
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	95	"cg: I think this is a bad hack, as it is too global."
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	96
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	97	\|size submenu item label fgColor bgColor labels defLabel\|
07786876f1fa * empty log message * ca parents: 3283 diff changeset	98
07786876f1fa * empty log message * ca parents: 3283 diff changeset	99	submenu := self userDefinedSubmenu.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	100	size := aColors size.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	101
07786876f1fa * empty log message * ca parents: 3283 diff changeset	102	size == 0 ifTrue:[ "/ separator
07786876f1fa * empty log message * ca parents: 3283 diff changeset	103	submenu addItem:(MenuItem label:'-').
07786876f1fa * empty log message * ca parents: 3283 diff changeset	104	^ self
07786876f1fa * empty log message * ca parents: 3283 diff changeset	105	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	106
07786876f1fa * empty log message * ca parents: 3283 diff changeset	107	labels := labelsOrNil ? #().
07786876f1fa * empty log message * ca parents: 3283 diff changeset	108	bgColor := aColors first.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	109	defLabel := ' '.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	110
07786876f1fa * empty log message * ca parents: 3283 diff changeset	111	bgColor brightness < 0.5 ifTrue:[ fgColor := Color white ]
07786876f1fa * empty log message * ca parents: 3283 diff changeset	112	ifFalse:[ fgColor := Color black ].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	113
07786876f1fa * empty log message * ca parents: 3283 diff changeset	114	aTitle isEmptyOrNil ifTrue:[ label := labels at:1 ifAbsent:defLabel ]
07786876f1fa * empty log message * ca parents: 3283 diff changeset	115	ifFalse:[ label := aTitle ].
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	116
3294 da0fdfe54c4e * empty log message * ca parents: 3293 diff changeset	117	label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:bgColor.
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	118	item := MenuItem labeled:label.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	119	submenu addItem:item.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	120
07786876f1fa * empty log message * ca parents: 3283 diff changeset	121	size == 1 ifTrue:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	122	item argument:bgColor.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	123	] ifFalse:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	124	item submenu:(submenu := Menu new).
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	125
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	126	aColors keysAndValuesDo:[:idx :aBgColor\|
07786876f1fa * empty log message * ca parents: 3283 diff changeset	127	aBgColor brightness < 0.5 ifTrue:[ fgColor := Color white ]
07786876f1fa * empty log message * ca parents: 3283 diff changeset	128	ifFalse:[ fgColor := Color black ].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	129
07786876f1fa * empty log message * ca parents: 3283 diff changeset	130	label := labels at:idx ifAbsent:defLabel.
3294 da0fdfe54c4e * empty log message * ca parents: 3293 diff changeset	131	label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:aBgColor.
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	132	item := MenuItem labeled:label.
3293 1ae2428ad1e5 * empty log message * ca parents: 3292 diff changeset	133	item argument:aBgColor.
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	134
07786876f1fa * empty log message * ca parents: 3283 diff changeset	135	submenu addItem:item.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	136	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	137	].
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	138
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	139	"
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	140	ColorMenu removeAllUserDefinedColors.
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	141
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	142	#(
07786876f1fa * empty log message * ca parents: 3283 diff changeset	143	#( Black 16r000000 )
07786876f1fa * empty log message * ca parents: 3283 diff changeset	144	#( Red 16rff0000 )
07786876f1fa * empty log message * ca parents: 3283 diff changeset	145	nil
07786876f1fa * empty log message * ca parents: 3283 diff changeset	146	#( Rust 16rff6600 16rff8533 16rffa366 16rffc299 16rffe0cc )
07786876f1fa * empty log message * ca parents: 3283 diff changeset	147	#( Tangerine 16rff9933 16rffad5c 16rffc285 16rffd6ad 16rffebd6 )
07786876f1fa * empty log message * ca parents: 3283 diff changeset	148	#( Sunflower 16rffcc00 16rfed633 16rfee066 16rffeb99 16rfff5cc )
07786876f1fa * empty log message * ca parents: 3283 diff changeset	149	#( Mango 16rffcc99 16rffd6ad 16rffe0c2 16rffebd6 16rfff5eb )
07786876f1fa * empty log message * ca parents: 3283 diff changeset	150	#( Buttercup 16rffff66 16rffff85 16rffffa3 16rffffc2 16rffffe0 )
07786876f1fa * empty log message * ca parents: 3283 diff changeset	151	#( Lemon 16rffffcc 16rffffd6 16rffffe0 16rffffeb 16rfffff5 )
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	152
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	153	) do:[:aDef\| \|colors title labels percentage\|
07786876f1fa * empty log message * ca parents: 3283 diff changeset	154	aDef isEmptyOrNil ifTrue:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	155	colors := labels := title := nil.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	156	] ifFalse:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	157	title := aDef first.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	158	colors := OrderedCollection new.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	159	labels := OrderedCollection new.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	160	percentage := 100.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	161
07786876f1fa * empty log message * ca parents: 3283 diff changeset	162	aDef from:2 do:[:rgb\|
07786876f1fa * empty log message * ca parents: 3283 diff changeset	163	colors add:(Color rgbValue:rgb).
07786876f1fa * empty log message * ca parents: 3283 diff changeset	164	labels add:('%1 %2 %%' bindWith:title with:percentage).
07786876f1fa * empty log message * ca parents: 3283 diff changeset	165	percentage := percentage - 20.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	166	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	167	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	168	ColorMenu addUserDefinedColors:colors labels:labels title:title.
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	169	].
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	170	"
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	171	!
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	172
3283 a0388721f027 * empty log message * ca parents: 3280 diff changeset	173	removeAllUserDefinedColors
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	174	"flush user defined colors"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	175
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	176	ColorMenuSpec := nil.
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	177	!
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	178
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	179	userDefinedSubmenu
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	180	"answer the menu entry under which the userdefined color entries are placed"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	181
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	182	\|menu submenu item icon\|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	183
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	184	menu := self colorMenu.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	185	item := menu detectItem:[:el\| (el nameKey == #userDefined and:[el submenu notNil]) ]
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	186	ifNone:nil.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	187
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	188	item isNil ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	189	icon := XPToolbarIconLibrary changesBrowser24x24Icon.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	190	item := MenuItem labeled:icon.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	191	item nameKey:#userDefined.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	192	item activeHelpKey:#userDefinedColors.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	193	menu addItem:item beforeIndex:1.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	194	].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	195
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	196	(submenu := item submenu) isNil ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	197	submenu := Menu new.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	198	item submenu:submenu.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	199	].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	200	^ submenu
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	201	! !
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	202
412 a8ad581658ec intitial checkin ca parents: diff changeset	203	!ColorMenu class methodsFor:'menu spec'!
a8ad581658ec intitial checkin ca parents: diff changeset	204
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	205	colorMenuSpec
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	206	"color definitions used to build a color menu
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	207	"
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	208	"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	209	ColorMenuSpec := nil.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	210	"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	211	^ #(
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	212	#( gray
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	213	gray:
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	214	#( white
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	215	veryLightGray
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	216	lightGray
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	217	gray
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	218	darkGray
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	219	veryDarkGray
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	220	black
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	221	)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	222	)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	223	"/ nil "/ separator
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	224	#( red
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	225	red:
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	226	#( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	227	)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	228	#( green
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	229	green:
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	230	#( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	231	)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	232	#( blue
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	233	blue:
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	234	#( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	235	)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	236	"/ nil "/ separator
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	237	#( cyan
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	238	cyan:
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	239	#( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	240	)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	241	#( magenta
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	242	magenta:
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	243	#( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	244	)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	245	#( yellow
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	246	yellow:
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	247	#( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	248	)
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	249
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	250	)
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	251	! !
07786876f1fa * empty log message * ca parents: 3283 diff changeset	252
07786876f1fa * empty log message * ca parents: 3283 diff changeset	253	!ColorMenu class methodsFor:'private'!
07786876f1fa * empty log message * ca parents: 3283 diff changeset	254
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	255	colorMenu
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	256	\|menuItem subItem baseColor color label getColSel submenu colorId\|
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	257
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	258	ColorMenuSpec notNil ifTrue:[ ^ ColorMenuSpec ].
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	259
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	260	ColorMenuSpec := Menu new.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	261
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	262	self colorMenuSpec do:[:aSlice\|
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	263	ColorMenuSpec addItem:(menuItem := MenuItem new).
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	264
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	265	aSlice notNil ifTrue:[
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	266	colorId := aSlice at:1.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	267	getColSel := aSlice at:2.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	268	baseColor := Color perform:colorId.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	269
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	270	menuItem label:(Text string:' ' emphasis:(#backgroundColor->baseColor)).
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	271	menuItem submenu:(submenu := Menu new).
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	272	menuItem isButton:true.
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	273
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	274	aSlice last do:[:el\|
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	275	color := label := nil.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	276
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	277	el isSymbol ifTrue:[
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	278	el == #veryLight ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	279	color := baseColor lightened lightened
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	280	] ifFalse:[ el == #lightened ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	281	color := baseColor perform:el
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	282	] ifFalse:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	283	color := Color perform:el
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	284	]].
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	285	colorId == #gray ifTrue:[ label := el ].
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	286	] ifFalse:[
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	287	el isNumber ifTrue:[
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	288	color := Color perform:getColSel with:el.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	289	].
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	290	].
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	291	color notNil ifTrue:[
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	292	label isNil ifTrue:[
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	293	label := getColSel, ' ', el printString.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	294	].
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	295	subItem := MenuItem label:' ',label,' '.
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	296	subItem argument:color.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	297	submenu addItem:subItem.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	298	].
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	299	]
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	300	].
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	301	].
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	302	^ ColorMenuSpec
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	303	!
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	304
3292 07786876f1fa * empty log message * ca parents: 3283 diff changeset	305	resolveMenuItem:aMenuItem value:aValue labelAreColored:labelAreColored
07786876f1fa * empty log message * ca parents: 3283 diff changeset	306	\|menuItem label color fgColor submenu\|
07786876f1fa * empty log message * ca parents: 3283 diff changeset	307
07786876f1fa * empty log message * ca parents: 3283 diff changeset	308	label := aMenuItem rawLabel ? ''.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	309	menuItem := MenuItem label:label.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	310	menuItem isButton:(aMenuItem isButton).
07786876f1fa * empty log message * ca parents: 3283 diff changeset	311
07786876f1fa * empty log message * ca parents: 3283 diff changeset	312	aMenuItem hasSubmenu ifFalse:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	313	color := aMenuItem argument.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	314	menuItem argument:color.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	315
07786876f1fa * empty log message * ca parents: 3283 diff changeset	316	(color isColor and:[label isText not]) ifTrue:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	317	labelAreColored ifTrue:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	318	label := Text string:label color:color.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	319	] ifFalse:[
07786876f1fa * empty log message * ca parents: 3283 diff changeset	320	color brightness < 0.5 ifTrue:[ fgColor := Color white ]
07786876f1fa * empty log message * ca parents: 3283 diff changeset	321	ifFalse:[ fgColor := Color black ].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	322
07786876f1fa * empty log message * ca parents: 3283 diff changeset	323	label := Text string:label foregroundColor:fgColor backgroundColor:color.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	324	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	325	menuItem label:label.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	326	menuItem value:aValue.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	327	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	328	^ menuItem
07786876f1fa * empty log message * ca parents: 3283 diff changeset	329	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	330	submenu := Menu new.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	331	aMenuItem submenu itemsDo:[:el\|
07786876f1fa * empty log message * ca parents: 3283 diff changeset	332	submenu addItem:(self resolveMenuItem:el value:aValue labelAreColored:labelAreColored).
07786876f1fa * empty log message * ca parents: 3283 diff changeset	333	].
07786876f1fa * empty log message * ca parents: 3283 diff changeset	334	menuItem submenu:submenu.
07786876f1fa * empty log message * ca parents: 3283 diff changeset	335	^ menuItem
592 c7813cfa8794 add more colors ca parents: 583 diff changeset	336	! !
c7813cfa8794 add more colors ca parents: 583 diff changeset	337
1808 e8628b502a49 methodCategory change Claus Gittinger <cg@exept.de> parents: 1803 diff changeset	338	!ColorMenu methodsFor:'accepting'!
412 a8ad581658ec intitial checkin ca parents: diff changeset	339
a8ad581658ec intitial checkin ca parents: diff changeset	340	accept:anItem
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	341	"accept the current selected item"
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	342
412 a8ad581658ec intitial checkin ca parents: diff changeset	343	\|item holder color\|
a8ad581658ec intitial checkin ca parents: diff changeset	344
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	345	((item := super accept:anItem) notNil
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	346	and: [((item nameKey ? '') startsWith:'pseudo') not])
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	347	ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	348	(holder := self colorHolder) == item ifTrue:[
412 a8ad581658ec intitial checkin ca parents: diff changeset	349	enabledChannel value ifTrue:[color := self color]
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	350	] ifFalse:[
666 801db9028157 provides a basic color menu reused by ca parents: 664 diff changeset	351	color := item argument.
692 fbf4503f8bc5 selection bug fixed tz parents: 668 diff changeset	352	holder label:(Text string:' ' emphasis:(#backgroundColor->color)).
412 a8ad581658ec intitial checkin ca parents: diff changeset	353	].
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	354	self choseColor:color.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	355	]
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	356	!
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	357
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	358	choseColor:aColor
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	359	"accept the current selected item"
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	360
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	361	model notNil ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	362	model value:aColor.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	363	RecentlyUsedColors isNil ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	364	RecentlyUsedColors := OrderedCollection new.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	365	].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	366	RecentlyUsedColors remove:aColor ifAbsent:[].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	367	RecentlyUsedColors addFirst:aColor.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	368	RecentlyUsedColors size > 20 ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	369	RecentlyUsedColors removeLast
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	370	].
412 a8ad581658ec intitial checkin ca parents: diff changeset	371	]
a8ad581658ec intitial checkin ca parents: diff changeset	372	! !
a8ad581658ec intitial checkin ca parents: diff changeset	373
a8ad581658ec intitial checkin ca parents: diff changeset	374	!ColorMenu methodsFor:'accessing'!
a8ad581658ec intitial checkin ca parents: diff changeset	375
a8ad581658ec intitial checkin ca parents: diff changeset	376	color
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	377	"get current color"
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	378
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	379	\|firstEmphasis\|
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	380	(firstEmphasis := (self colorHolder label emphasis at:1)) isAssociation ifTrue: [^firstEmphasis value].
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	381	^(firstEmphasis at: 1) value
412 a8ad581658ec intitial checkin ca parents: diff changeset	382	!
a8ad581658ec intitial checkin ca parents: diff changeset	383
a8ad581658ec intitial checkin ca parents: diff changeset	384	color:aColor
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	385	"set current color"
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	386
412 a8ad581658ec intitial checkin ca parents: diff changeset	387	\|holder label\|
a8ad581658ec intitial checkin ca parents: diff changeset	388
2184 16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	389	aColor isColor ifFalse:[
412 a8ad581658ec intitial checkin ca parents: diff changeset	390	enabledChannel value:false
2184 16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	391	] ifTrue:[
16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	392	self
16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	393	disabledRedrawDo:
16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	394	[
16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	395	holder := self colorHolder.
16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	396	label := Text string: ' ' emphasis:(#backgroundColor->aColor).
16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	397	enabledChannel value:true.
16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	398	holder label:label.
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	399	self choseColor:aColor
2184 16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	400	]
412 a8ad581658ec intitial checkin ca parents: diff changeset	401	]
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	402	!
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	403
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	404	labelsAreColored: aBoolean
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	405	"sets whether labels or their backgrounds will be colored"
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	406
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	407	\|bool\|
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	408
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	409	bool := aBoolean ? false.
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	410
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	411	labelsAreColored ~~ bool ifTrue:[
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	412	labelsAreColored := bool.
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	413	self setupMenu
c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	414	].
412 a8ad581658ec intitial checkin ca parents: diff changeset	415	! !
a8ad581658ec intitial checkin ca parents: diff changeset	416
1818 fe99c5c721e9 category changes Claus Gittinger <cg@exept.de> parents: 1816 diff changeset	417	!ColorMenu methodsFor:'accessing-channels'!
412 a8ad581658ec intitial checkin ca parents: diff changeset	418
a8ad581658ec intitial checkin ca parents: diff changeset	419	model:aValueHolder
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	420	"set my color channel"
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	421
2184 16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	422	super model:aValueHolder.
2183 5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	423	model notNil ifTrue:[
2186 05b16a66bb3d updateFromModel Claus Gittinger <cg@exept.de> parents: 2184 diff changeset	424	self updateFromModel
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	425	]
412 a8ad581658ec intitial checkin ca parents: diff changeset	426	! !
a8ad581658ec intitial checkin ca parents: diff changeset	427
a8ad581658ec intitial checkin ca parents: diff changeset	428	!ColorMenu methodsFor:'change & update'!
a8ad581658ec intitial checkin ca parents: diff changeset	429
2186 05b16a66bb3d updateFromModel Claus Gittinger <cg@exept.de> parents: 2184 diff changeset	430	updateFromModel
2184 16d3b72ca431 use inherited functionality Claus Gittinger <cg@exept.de> parents: 2183 diff changeset	431	self color:(model value)
412 a8ad581658ec intitial checkin ca parents: diff changeset	432	! !
a8ad581658ec intitial checkin ca parents: diff changeset	433
a8ad581658ec intitial checkin ca parents: diff changeset	434	!ColorMenu methodsFor:'initialization'!
a8ad581658ec intitial checkin ca parents: diff changeset	435
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	436	colorHistorySubmenu
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	437	\|menu\|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	438
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	439	RecentlyUsedColors isEmptyOrNil ifTrue:[^ nil].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	440
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	441	menu := Menu new.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	442
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	443	RecentlyUsedColors do:[:clr \|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	444	\|label fgColor item\|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	445
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	446	clr brightness < 0.5 ifTrue:[ fgColor := Color white ]
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	447	ifFalse:[ fgColor := Color black ].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	448
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	449	label := clr htmlPrintString.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	450	label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:clr.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	451	item := MenuItem labeled:label.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	452	item argument:clr.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	453
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	454	menu addItem:item.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	455	].
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	456
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	457	^ menu.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	458	!
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	459
412 a8ad581658ec intitial checkin ca parents: diff changeset	460	destroy
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	461	"release color channel dependency"
53f8cdd4462c * empty log message * tz parents: 617 diff changeset	462
412 a8ad581658ec intitial checkin ca parents: diff changeset	463	self model:nil.
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	464	super destroy
412 a8ad581658ec intitial checkin ca parents: diff changeset	465
a8ad581658ec intitial checkin ca parents: diff changeset	466	!
a8ad581658ec intitial checkin ca parents: diff changeset	467
a8ad581658ec intitial checkin ca parents: diff changeset	468	initialize
a8ad581658ec intitial checkin ca parents: diff changeset	469	super initialize.
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	470	labelsAreColored := true. "false."
2254 ebd685bcba77 starting removing #menuAdornmentAt: ca parents: 2186 diff changeset	471	verticalLayout := false.
ebd685bcba77 starting removing #menuAdornmentAt: ca parents: 2186 diff changeset	472
412 a8ad581658ec intitial checkin ca parents: diff changeset	473	self fitFirstPanel:false.
895 d1c9210e796b checkin from browser Claus Gittinger <cg@exept.de> parents: 854 diff changeset	474	enabledChannel := ValueHolder with:false.
412 a8ad581658ec intitial checkin ca parents: diff changeset	475	self setupMenu.
895 d1c9210e796b checkin from browser Claus Gittinger <cg@exept.de> parents: 854 diff changeset	476
d1c9210e796b checkin from browser Claus Gittinger <cg@exept.de> parents: 854 diff changeset	477	"Modified: / 21.5.1998 / 03:07:26 / cg"
412 a8ad581658ec intitial checkin ca parents: diff changeset	478	!
a8ad581658ec intitial checkin ca parents: diff changeset	479
a8ad581658ec intitial checkin ca parents: diff changeset	480	setupMenu
666 801db9028157 provides a basic color menu reused by ca parents: 664 diff changeset	481	\|menu item\|
412 a8ad581658ec intitial checkin ca parents: diff changeset	482
666 801db9028157 provides a basic color menu reused by ca parents: 664 diff changeset	483	menu := self class colorMenu:labelsAreColored value:nil.
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	484
2183 5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	485	menu
5c69691590eb code cleanup; now inherit model instVar. Claus Gittinger <cg@exept.de> parents: 2167 diff changeset	486	addItem:(
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	487	(MenuItem labeled:nil)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	488	labelImage:(ToolbarIconLibrary palette16x16Icon);
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	489	value:[ self openColorEditDialog ];
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	490	nameKey:#pseudoDef;
3280 c42ab6572f32 support adding user defined colors ca parents: 3129 diff changeset	491	isButton: true).
806 abed5a47e545 separators removed and color orange added tz parents: 692 diff changeset	492
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	493	menu
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	494	addItem:(
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	495	(MenuItem labeled:nil)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	496	labelImage:(ToolbarIconLibrary pipette16x16Icon);
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	497	value:[ self pickColorFromScreen ];
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	498	nameKey:#pseudoPick;
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	499	isButton: true).
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	500
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	501	menu
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	502	addItem:(
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	503	(MenuItem labeled:nil)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	504	labelImage:(ToolbarIconLibrary colorHistory16x16Icon);
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	505	submenuChannel:[ self colorHistorySubmenu ];
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	506	nameKey:#seudoHhistory;
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	507	isButton: false)
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	508	beforeIndex:1.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	509
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	510	"/ menu addItem:(MenuItem label:'') beforeIndex:1.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	511
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	512	item := MenuItem labeled:(Text string:' ' emphasis:(#backgroundColor->DefaultViewBackgroundColor)).
666 801db9028157 provides a basic color menu reused by ca parents: 664 diff changeset	513	item value:#selection.
801db9028157 provides a basic color menu reused by ca parents: 664 diff changeset	514	menu addItem:item beforeIndex:1.
806 abed5a47e545 separators removed and color orange added tz parents: 692 diff changeset	515
412 a8ad581658ec intitial checkin ca parents: diff changeset	516	self menu:menu.
a8ad581658ec intitial checkin ca parents: diff changeset	517
666 801db9028157 provides a basic color menu reused by ca parents: 664 diff changeset	518	self do:[:anItem\|
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	519	anItem value == #selection ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	520	anItem indication:enabledChannel
666 801db9028157 provides a basic color menu reused by ca parents: 664 diff changeset	521	] ifFalse:[
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	522	anItem enabled:enabledChannel.
412 a8ad581658ec intitial checkin ca parents: diff changeset	523	]
664 53f8cdd4462c * empty log message * tz parents: 617 diff changeset	524	]
412 a8ad581658ec intitial checkin ca parents: diff changeset	525	! !
a8ad581658ec intitial checkin ca parents: diff changeset	526
a8ad581658ec intitial checkin ca parents: diff changeset	527	!ColorMenu methodsFor:'private'!
a8ad581658ec intitial checkin ca parents: diff changeset	528
a8ad581658ec intitial checkin ca parents: diff changeset	529	colorHolder
a8ad581658ec intitial checkin ca parents: diff changeset	530	"returns the item which keeps the selected color in its label
a8ad581658ec intitial checkin ca parents: diff changeset	531	"
a8ad581658ec intitial checkin ca parents: diff changeset	532	^ self itemAt:#selection
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	533	!
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	534
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	535	openColorEditDialog
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	536	\|defineColorDialog\|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	537
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	538	defineColorDialog := ColorEditDialog new color: self color.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	539	defineColorDialog open.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	540	defineColorDialog accept value ifTrue: [
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	541	self color:defineColorDialog color
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	542	]
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	543	!
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	544
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	545	pickColorFromScreen
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	546	\|color\|
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	547
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	548	color := Color fromUser.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	549	color notNil ifTrue:[
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	550	self color:color.
1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	551	]
412 a8ad581658ec intitial checkin ca parents: diff changeset	552	! !
a8ad581658ec intitial checkin ca parents: diff changeset	553
a8ad581658ec intitial checkin ca parents: diff changeset	554	!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin ca parents: diff changeset	555
a8ad581658ec intitial checkin ca parents: diff changeset	556	version
3322 1a51da8de402 much improved; code cleanup Claus Gittinger <cg@exept.de> parents: 3304 diff changeset	557	^ '$Header: /cvs/stx/stx/libwidg2/ColorMenu.st,v 1.42 2008-01-27 16:08:51 cg Exp $'
412 a8ad581658ec intitial checkin ca parents: diff changeset	558	! !

author	Claus Gittinger <cg@exept.de>
	Sun, 27 Jan 2008 17:08:51 +0100
changeset 3322	1a51da8de402
parent 3304	f589791dd24c
child 3323	b4aef3ba5d24
permissions	-rw-r--r--