[comp.lang.smalltalk] ST-80 R4 Goodie

benson@milton.u.washington.edu (Dan Benson) (03/17/91)

Here's a little goodie written for Smalltalk-80 Release 4.  It's a DialogView
that allows you to edit the three color attributes of a ColorValue in any of three possible modes (RGB, CMY, or HSB) by either typing in their values or moving sliders.  The color appears as a swatch in the view and acts as a button that brings up a scrollable list of predefined colors.

Enjoy!

Dan Benson

--------- snip snip -------- snip snip --------- snip snip ---------
Model subclass: #ColorChooser
	instanceVariableNames: 'one two three mode color finished '
	classVariableNames: 'ColorSwatch '
	poolDictionaries: ''
	category: 'ColorChooser'!
ColorChooser comment:
'Please send comments, suggestions and improvements to:

	Dan Benson
	Dept. of EE, FT-10
	University of Washington
	Seattle, WA  98195
	USA
	benson@ee.washington.edu

Class ColorChooser represents an interface for selecting/editing a ColorValue, returning the final color (or nil).  It is presented as a dialog view and can be used as a stand-alone method of selecting a color or called upon from within an application.  An instance can be created specifying an initial color and initial mode.

The dialog view contains 3 radio buttons to select one of 3 color modes (RGB, CMY, or HSB).  The edited color is displayed as a colored button which can be pressed to bring up a scrollable list of available predefined colors.  The three color components can be modified either via text fields or slider widgets.  As a DialogView, it must be closed (by pressing either Cancel or Accept) before control is given away.  Pressing Cancel returns nil while pressing Accept returns the color appearing in the view.  Up







on opening, the view is centered on the cursor and can be moved by grabbing near the edge.

It was developed on a Macintosh using 256 colors.  With a black & white screen the colors appear as patterns.

See the examples in the class methods.

Instance Variables:
	one two three	<Float> the values of each of the three color attributes (depending on the mode)
	mode			<SmallInteger> 1 = RGB, 2 = CMY, 3 = HSB
	color			<ColorValue> the current ColorValue being editing
	finished		<Boolean>	indicates whether Cancel or Accept has been pressed

Class Variable:
	ColorSwatch	<Pixmap> used to display a color swatch of the current color'!


!ColorChooser methodsFor: 'initialize'!

initializeColor: aColorValue mode: oneTwoOrThree
	finished := false.
	mode := oneTwoOrThree.
	self setColor: aColorValue.! !

!ColorChooser methodsFor: 'one two three'!

one
	^one!

one: aNumber
	"Only set the new value if it's within 1/100th of the previous value.  Prevents continuous flashing while using the slider."
	| newValue |
	newValue := (aNumber min: 1.0) max: 0.0.
	(one - newValue) abs >= 0.01
		ifTrue: [one := newValue.
				self changed: #one.
				self changed: #color]!

oneText
	"Answer the current value of one with only 5 digits so that it looks good in the text field."
	| aStream |
	aStream := WriteStream on: (String new: 8).
	one asFloat printOn: aStream digits: 5.
	^aStream contents asText!

three
	^three!

three: aNumber
	"Only set the new value if it's within 1/100th of the previous value.  Prevents continuous flashing while using the slider."
	| newValue |
	newValue := (aNumber min: 1.0) max: 0.0.
	(three - newValue) abs >= 0.01
		ifTrue: [three := newValue.
				self changed: #three.
				self changed: #color]!

threeText
	"Answer the current value of three with only 5 digits so that it looks good in the text field."
	| aStream |
	aStream := WriteStream on: (String new: 8).
	three asFloat printOn: aStream digits: 5.
	^aStream contents asText!

two
	^two!

two: aNumber
	"Only set the new value if it's within 1/100th of the previous value.  Prevents continuous flashing while using the slider."
	| newValue |
	newValue := (aNumber min: 1.0) max: 0.0.
	(two - newValue) abs >= 0.01
		ifTrue: [two := newValue.
				self changed: #two.
				self changed: #color]!

twoText
	"Answer the current value of two with only 5 digits so that it looks good in the text field."
	| aStream |
	aStream := WriteStream on: (String new: 8).
	two asFloat printOn: aStream digits: 5.
	^aStream contents asText! !

!ColorChooser methodsFor: 'mode'!

getMode
	^mode!

setMode: anInteger
	"Change the mode to be anInteger (1, 2, or 3), then reinterpret the three color attributes of color using the new mode."
	| a b c  |
	mode := anInteger.
	mode = 1 "RGB"
		ifTrue: [a := color red.
				b := color green.
				c := color blue].
	mode = 2 "CMY"
		ifTrue: [a := color cyan.
				b := color magenta.
				c := color yellow].
	mode = 3 "HSB"
		ifTrue: [a := color hue.
				b := color saturation.
				c := color brightness].
	self one: a two: b three: c.
	self changed: #mode! !

!ColorChooser methodsFor: 'color list menu'!

chooseFromList
	"Pop up a scrolling list of all currently available pre-defined colors.  If one is chosen, make that the currentColor.  If cancel is chosen, do nothing."
	| newColor |
	newColor := DialogView
			show: (PopUpMenu labelList: (Array with: ColorValue constantNames)) 
			withLabel: 'Pick a color'.
	newColor > 0
		ifTrue: [self setColor: (ColorValue perform: (ColorValue constantNames at: newColor))]! !

!ColorChooser methodsFor: 'private'!

accept
	"This is sent whenever <cr> is pressed in one of the text fields.  Just ignore it."!

changed: anAspect
	"If any aspect of the color changed, it must be reset."
	(anAspect == #color)
		ifTrue: [	self resetColor].
	super changed: anAspect!

one: firstValue two: secondValue three: thirdValue
	"Set all three color attributes in one shot."
	one := firstValue.
	two := secondValue.
	three := thirdValue.
	self changed: #one.
	self changed: #two.
	self changed: #three.!

resetColor
	"Reset color based on the current mode, and update the color swatch."
	color := mode = 1
		ifTrue: [ColorValue red: one green: two blue: three] "RGB"
		ifFalse: [mode = 2
				ifTrue: [ColorValue cyan: one magenta: two yellow: three] "CMY"
				ifFalse: [ColorValue hue: one saturation: two brightness: three]]. "HSB"
	self class paintSwatch: color!

setColor: aColorValue
	"Set the three color attributes to those of aColorValue using the current mode."
	| a b c |
	mode = 1 "RGB"
		ifTrue: [a := aColorValue red.
				b := aColorValue green.
				c := aColorValue blue].
	mode = 2 "CMY"
		ifTrue: [a := aColorValue cyan.
				b := aColorValue magenta.
				c := aColorValue yellow].
	mode = 3 "HSB"
		ifTrue: [a := aColorValue hue.
				b := aColorValue saturation.
				c := aColorValue brightness].
	self one: a two: b three: c.
	self changed: #color! !

!ColorChooser methodsFor: 'finishing'!

doAccept
	"The Accept button was pressed so signal that we're done."
	finished := true!

doCancel
	"The Cancel button was pressed so signal that we're done but set currentColor to nil."
	finished := true.
	color := nil!

finalColor
	^color!

hasColor
	^finished! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ColorChooser class
	instanceVariableNames: ''!


!ColorChooser class methodsFor: 'instance creation'!

new
	self error: 'Must use an "open" message when creating an instance of ', self name!

open
	"Open a ColorChooser with initial default color and default mode."
	"ColorChooser open"
	^self openWithColor: self defaultColor mode: self defaultMode!

openWithColor: aColorValue
	"Open a ColorChooser with initial color aColorValueOrNil and default mode."
	"ColorChooser openWithColor: ColorValue red"
	^self openWithColor: aColorValue mode: self defaultMode!

openWithColor: aColorValue mode: anInteger
	"Open a ColorChooser with initial color set to aColorValueOrNil and initial mode set to anInteger."
	"ColorChooser openWithColor: ColorValue red mode: ColorChooser cmy"
	| aCCModel windowSize sliderView labels textAdaptor dialog cancel accept paintButton paintView offset sliderHeight |

"Bulletproof the arguments here."
	self initializeSwatch.
	aCCModel := super new
		initializeColor: ((aColorValue isKindOf: ColorValue) ifTrue: [aColorValue] ifFalse: [self defaultColor])
		mode: ((#(1 2 3) includes: anInteger) ifTrue: [anInteger asInteger] ifFalse: [self defaultMode]).

	windowSize := 150@185.
	dialog := DialogView new.
	dialog width: windowSize x.
	dialog model: aCCModel.

"I wanted a way of displaying a color swatch and at the same time having a button-like action to bring up a scrollable list of selectable colors.  I came up with the paintButton which is probably not the most elegant way to accomplish this.  It relys on the ColorSwatch class variable for its color which is updated when the color is changed."
"Paint Button"
	paintButton := (PluggableAdaptor on: aCCModel)
		getBlock: [:model | false]
		putBlock: [:model :value | ]
		updateBlock: [:model :updateAspect :updateParameter | updateAspect == #color].
	paintView := LabeledBooleanView model: paintButton.
	paintView beVisual: ColorSwatch. "This sets up the relationship."
	paintView controller beButton.
	paintView controller controlBlock: [:cursorPoint :button | button == #wentUp ifTrue: [aCCModel chooseFromList]].
	BoundedWrapper on: paintView.
	dialog add: (paintView) borderedIn: ((windowSize x/2 @0) extent: ((windowSize x /2 - 2) @78)).

"Here's where the modes are associated with the numbers 1, 2, 3."
	labels := #('RGB' 'CMY' 'HSB').
	dialog
		leftIndent: 15; rightIndent: windowSize x/2; yPosition: 10;
		addColumn: (1 to: labels size)
		fromX: 0 toX: 1
		collect:
			[:i | | button view |
			button := (PluggableAdaptor on: aCCModel) 
				getBlock: [:model | model getMode = i]
				putBlock: [:model :value |  model setMode: i]
				updateBlock: [:model :updateAspect :updateParameter | updateAspect == #mode].
			view := LabeledBooleanView model: button.
			view beRadioButton.
			view label: (labels at: i).
			view controller beToggle.
			BoundedWrapper on: view].

"I originally wrote this on a large display and I had the default TextAttributes set to #large.  When I tried it in an image with smaller font sizes the layout was not pretty anymore.  I haven't figured out how to deal with fonts yet but here's a quick hack that solves it but it really needs to be done properly."
	(CharacterAttributes default defaultFont pixelSize <= 12)
		ifTrue: [sliderHeight := 19.
				offset := 0]
		ifFalse: [sliderHeight := 20.
				offset := 3].
"one Slider"
	sliderView := FractionalWidgetView new beHorizontal.
	sliderView controller beSlider.
	sliderView model: ((PluggableAdaptor on: aCCModel) getSelector: #one putSelector: #one:).
	dialog add: sliderView borderedIn: (windowSize x /2 @ (80 + offset) extent: (windowSize x /2 - 2) @ sliderHeight).
"one Text"
	dialog leftIndent: 2; rightIndent: windowSize x /2 - 5; yPosition: 80.
	textAdaptor := ((PluggableAdaptor on: aCCModel)
			getBlock: [:model | model oneText]
			putBlock: [:model :value | model one: value asNumber]
			updateBlock: [:model :updateAspect :updateParameter | updateAspect == #one]).
	dialog addTextFieldOn: textAdaptor initially: aCCModel oneText.

"two Slider"
	sliderView := FractionalWidgetView new beHorizontal.
	sliderView controller beSlider.
	sliderView model: ((PluggableAdaptor on: aCCModel) getSelector: #two putSelector: #two:).
	dialog add: sliderView borderedIn: (windowSize x /2 @ (102 + offset) extent: (windowSize x /2 - 2) @ sliderHeight).
"two Text"
	dialog leftIndent: 2; rightIndent: windowSize x /2 - 5; yPosition: 102.
	textAdaptor := ((PluggableAdaptor on: aCCModel)
			getBlock: [:model | model twoText]
			putBlock: [:model :value | model two: value asNumber]
			updateBlock: [:model :updateAspect :updateParameter | updateAspect == #two]).
	dialog addTextFieldOn: textAdaptor initially: aCCModel twoText.

"three Slider"
	sliderView := FractionalWidgetView new beHorizontal.
	sliderView controller beSlider.
	sliderView model: ((PluggableAdaptor on: aCCModel) getSelector: #three putSelector: #three:).
	dialog add: sliderView borderedIn: (windowSize x /2 @ (124 + offset) extent: (windowSize x /2 - 2) @ sliderHeight).
"three Text"
	dialog leftIndent: 2; rightIndent: windowSize x /2 - 5; yPosition: 124.
	textAdaptor := ((PluggableAdaptor on: aCCModel)
			getBlock: [:model | model threeText]
			putBlock: [:model :value | model three: value asNumber]
			updateBlock: [:model :updateAspect :updateParameter | updateAspect == #three]).
	dialog addTextFieldOn: textAdaptor initially: aCCModel threeText.

	dialog leftIndent: 0; rightIndent: windowSize x; yPosition: windowSize y.

"Button for Cancel"
	cancel := LabeledBooleanView new model:
		((PluggableAdaptor on: aCCModel)
			getBlock: [:model | false]
			putBlock: [:model :value | model doCancel]
			updateBlock: [:model :updateAspect :updateParameter | false]).
	cancel beVisual: ' Cancel ' asComposedText.
	cancel controller beTriggerOnUp.
	cancel := (BorderedWrapper on: cancel) inset: 2.

"Button for Accept"
	accept := LabeledBooleanView new model:
		((PluggableAdaptor on: aCCModel)
			getBlock: [:model | false]
			putBlock: [:model :value | model doAccept]
			updateBlock: [:model :updateAspect :updateParameter | false]).
	accept beVisual: ' Accept ' asText allBold asComposedText.
	accept controller beTriggerOnUp.
	accept := (BorderedWrapper on: accept) borderWidth: 2.

	dialog indent: 0.
	dialog  yPosition: 155; addWrapper: cancel atX: 0.1.
	dialog  yPosition: 155; addWrapper: accept atX: 0.9.

	dialog openFinishedSelector: #hasColor.
	^aCCModel finalColor!

openWithMode: anInteger
	"Open a ColorChooser with the default color and initial mode anInteger."
	"ColorChooser openWithMode: ColorChooser hsb"
	^self openWithColor: self defaultColor mode: anInteger! !

!ColorChooser class methodsFor: 'color swatch'!

initializeSwatch
	"This is initialized each invocation because the pixel depth of the Screen can change."
	"There must be a better way of obtaining the Screen's current pixel depth.  The way I finally did it was to grab a tiny image from the default Screen and get its depth."
	ColorSwatch := Pixmap extent: (75@78) depth: ((Screen default contentsOfArea: (0@0 extent: 1@1)) at: 1) depth!

paintSwatch: aColorValue
	ColorSwatch graphicsContext
		paint: aColorValue;
		displayRectangle: (0@0 extent: 75@78)! !

!ColorChooser class methodsFor: 'defaults'!

cmy
	^2!

defaultColor
	"Change this for a different initial color."
	^LookPreferences colorDefault selectionBackgroundColor!

defaultMode
	^self rgb!

hsb
	^3!

rgb
	^1! !

!ColorChooser class methodsFor: 'examples'!

example1
	"Open the ColorChooser using the default color and default mode."
	"ColorChooser example1"
	| aColor |
	aColor := ColorChooser open.
	Transcript cr; show: 'Color chosen: ', (aColor isNil ifTrue: ['none'] ifFalse: [aColor printString]), '.'; endEntry.!

example2
	"Open the ColorChooser with the initial color red and default mode."
	"ColorChooser example2"
	| aColor |
	aColor := ColorChooser openWithColor: ColorValue red.
	Transcript cr; show: 'Color chosen: ', (aColor isNil ifTrue: ['none'] ifFalse: [aColor printString]), '.'; endEntry.!

example3
	"Open the ColorChooser with the default color and mode CMY."
	"ColorChooser example3"
	| aColor |
	aColor := ColorChooser openWithMode: ColorChooser cmy.
	Transcript cr; show: 'Color chosen: ', (aColor isNil ifTrue: ['none'] ifFalse: [aColor printString]), '.'; endEntry.!

example4
	"Open the ColorChooser with initial color green and mode HSB."
	"ColorChooser example4"
	| aColor |
	aColor := ColorChooser openWithColor: ColorValue green mode: ColorChooser hsb.
	Transcript cr; show: 'Color chosen: ', (aColor isNil ifTrue: ['none'] ifFalse: [aColor printString]), '.'; endEntry.!

example5
	"Open the ColorChooser with a specific initial color green and mode RGB."
	"ColorChooser example5"
	| aColor |
	aColor := ColorChooser openWithColor: (ColorValue red: 0.83079 green: 0.553901 blue: 0.323037)
							mode: ColorChooser rgb.
	Transcript cr; show: 'Color chosen: ', (aColor isNil ifTrue: ['none'] ifFalse: [aColor printString]), '.'; endEntry.! !