=============== Summary ===============
Change Set: pluggableSlider
Date: 28 December 2022
Author: Christoph Thiede
Adds a simple slider widget to the ToolBuilder and connects it to the existing implementation in Morphic. An MVC implementation is not provided at this point. Adds a demo model for using the slider to MorphicExtras-Demo. Also makes some improvements to the existing Morphic Slider hierarchy:
* Don't reset a scroll bar when changing its extent (ScrollBar>>#updateSlider). This issue was only observable when the scroll bar was not contained in a ScrollPane which would change the scroll bar value manually.
* Add getQuantumSelector to Slider.
* Prevent Slider construction from implicitly resetting the slider value.
Treats ToolBuilder-Kernel-ct.139 and ToolBuilder-Morphic-ct.254.
=============== Diff ===============
MorphicToolBuilder>>buildPluggableSlider: {widgets required} · ct 12/28/2022 18:18
+ buildPluggableSlider: spec
+
+ | widget |
+ widget := self sliderClass
+ on: spec model
+ getValue: spec getValue
+ setValue: spec setValue
+ min: spec minValue
+ max: spec maxValue
+ quantum: spec quantum.
+ self register: widget id: spec name.
+
+ spec interval ifNotNil: [:interval | widget interval: interval].
+ spec color ifNotNil: [:color | widget color: color].
+ self buildHelpFor: widget spec: spec.
+ self setFrame: spec frame in: widget.
+ self setLayoutHintsFor: widget spec: spec.
+ parent ifNotNil: [self add: widget to: parent].
+ ^ widget
MorphicToolBuilder>>sliderClass {widget classes} · ct 12/28/2022 20:06
+ sliderClass
+
+ ^ ScrollBar
PluggableSliderSpec
+ PluggableWidgetSpec subclass: #PluggableSliderSpec
+ instanceVariableNames: 'getValue setValue minValue maxValue quantum interval'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolBuilder-Kernel'
+
+ PluggableSliderSpec class
+ instanceVariableNames: ''
+
+ "A slider to choose a numeric value from a concrete or discrete 1-dimensional range."
PluggableSliderSpec>>buildWith: {building} · ct 2/10/2020 11:12
+ buildWith: builder
+
+ ^ builder buildPluggableSlider: self
PluggableSliderSpec>>getValue {accessing} · ct 2/10/2020 11:10
+ getValue
+ "Answer the selector for getting the slider's value."
+ ^ getValue
PluggableSliderSpec>>getValue: {accessing} · ct 2/10/2020 11:11
+ getValue: aSymbol
+ "Set the selector for getting the slider's value."
+ getValue := aSymbol
PluggableSliderSpec>>initialize {initialize-release} · ct 12/28/2022 18:15
+ initialize
+
+ super initialize.
+
+ interval := 0.
PluggableSliderSpec>>interval {accessing} · ct 12/28/2022 20:04
+ interval
+ "Answer the interval for the slider extent, a number. 0 for automatic minimal extent."
+ ^ interval
PluggableSliderSpec>>interval: {accessing} · ct 12/28/2022 20:04
+ interval: aNumber
+ "Set the interval for the slider extent. 0 for automatic minimal extent."
+ interval := aNumber
PluggableSliderSpec>>maxValue {accessing} · ct 12/28/2022 18:13
+ maxValue
+ "Answer the maximum slider value, a number or symbol."
+ ^ maxValue
PluggableSliderSpec>>maxValue: {accessing} · ct 12/28/2022 18:13
+ maxValue: aNumberOrSymbol
+ "Set the maximum slider value."
+ maxValue := aNumberOrSymbol
PluggableSliderSpec>>minValue {accessing} · ct 12/28/2022 18:13
+ minValue
+ "Answer the minimum slider value, a number or symbol."
+ ^ minValue
PluggableSliderSpec>>minValue: {accessing} · ct 12/28/2022 18:13
+ minValue: aNumberOrSymbol
+ "Set the minimum slider value."
+ minValue := aNumberOrSymbol
PluggableSliderSpec>>quantum {accessing} · ct 12/28/2022 18:12
+ quantum
+ "Answer the rounding quantum for the slider value, a symbol or number."
+ ^ quantum
PluggableSliderSpec>>quantum: {accessing} · ct 12/28/2022 18:13
+ quantum: aNumberOrSymbol
+ "Set the rounding quantum for the slider value."
+ quantum := aNumberOrSymbol
PluggableSliderSpec>>setValue {accessing} · ct 2/10/2020 11:12
+ setValue
+ "Answer the selector for setting the slider's value."
+ ^ setValue
PluggableSliderSpec>>setValue: {accessing} · ct 2/10/2020 11:12
+ setValue: aSymbol
+ "Set the selector for setting the slider's value."
+ setValue := aSymbol
ScrollBar>>updateSlider {updating} · ct 12/28/2022 18:03 (changed)
updateSlider
| imagesNeedUpdate |
imagesNeedUpdate := upButton width ~= (self orientation == #horizontal ifTrue: [self height] ifFalse: [self width]).
self menuButton
visible: (self orientation == #horizontal or: [self class scrollBarsWithoutMenuButton]) not;
disableLayout: self menuButton visible not;
bounds: self boundsForMenuButton.
self upButton
visible: self class scrollBarsWithoutArrowButtons not;
disableLayout: self upButton visible not;
bounds: self boundsForUpButton.
self downButton
visible: self class scrollBarsWithoutArrowButtons not;
disableLayout: self downButton visible not;
bounds: self boundsForDownButton.
- super updateSlider.
-
- pagingArea bounds: self totalSliderArea.
+ self orientation == #horizontal
+ ifTrue: [slider height: self totalSliderArea height]
+ ifFalse: [slider width: self totalSliderArea width].
self expandSlider.
+ sliderShadow bounds: slider bounds.
+ pagingArea bounds: self totalSliderArea.
+ self computeSlider.
imagesNeedUpdate ifTrue: [
self menuButton visible ifTrue: [self updateMenuButtonImage].
self upButton visible ifTrue: [self updateUpButtonImage].
self downButton visible ifTrue: [self updateDownButtonImage]].
Slider (changed)
MorphicModel subclass: #Slider
- instanceVariableNames: 'slider value setValueSelector getValueSelector sliderShadow sliderColor descending minimumValue maximumValue quantum getMinimumValueSelector getMaximumValueSelector orientation'
+ instanceVariableNames: 'slider value setValueSelector getValueSelector sliderShadow sliderColor descending minimumValue maximumValue quantum getMinimumValueSelector getMaximumValueSelector getQuantumSelector orientation'
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Windows'
Slider class
instanceVariableNames: ''
"I am a widget that helps users enter a numerically bounded value. I have a minimum and a maximum value. My thumb indicates my current value. My orientation can be vertical or horizontal, which is usually determined by the ratio of my extent. Nevertheless, you can force me to use a specific orientation,
Note that I can be pluggable and get data from a model."
Slider class>>on:getValue:setValue:min:max:quantum: {instance creation} · ct 12/28/2022 17:29 (changed)
- on: anObject getValue: getSel setValue: setSel min: min max: max quantum: quantum
- "Answer a new instance of the receiver with
- the given selectors as the interface."
+ on: anObject getValue: getSel setValue: setSel min: minValueOrSel max: maxValueOrSel quantum: quantumValueOrSel
- | instance |
- instance := self new
- quantum: quantum;
+ ^ self new
on: anObject
getValue: getSel
- setValue: setSel.
- min isSymbol
- ifTrue: [instance getMinimumValueSelector: min]
- ifFalse: [instance minimumValue: min].
- max isSymbol
- ifTrue: [instance getMaximumValueSelector: max]
- ifFalse: [instance maximumValue: max].
- ^ instance
+ setValue: setSel
+ min: minValueOrSel
+ max: maxValueOrSel
+ quantum: quantumValueOrSel
Slider>>getQuantum {model access} · ct 12/28/2022 17:02
+ getQuantum
+
+ self getQuantumSelector ifNotNil: [:selector |
+ self quantum: (model perform: selector)].
+ ^ self quantum
Slider>>getQuantumSelector {accessing - model} · ct 12/28/2022 17:00
+ getQuantumSelector
+
+ ^ getQuantumSelector
Slider>>getQuantumSelector: {accessing - model} · ct 12/28/2022 17:01
+ getQuantumSelector: aSymbol
+
+ getQuantumSelector := aSymbol.
Slider>>maximumValue: {accessing} · ct 12/28/2022 18:06 (changed)
maximumValue: aNumber
maximumValue := aNumber.
- self setValue: self value.
+ self setValue: self value.
+ self computeSlider.
Slider>>minimumValue: {accessing} · ct 12/28/2022 18:06 (changed)
minimumValue: aNumber
minimumValue := aNumber.
- self setValue: self value.
+ self setValue: self value.
+ self computeSlider.
Slider>>on:getValue:setValue:min:max:quantum: {initialization} · ct 12/28/2022 17:37
+ on: anObject getValue: getSel setValue: setSel min: minValueOrSel max: maxValueOrSel quantum: quantumValueOrSel
+
+ self
+ model: anObject;
+ getValueSelector: getSel;
+ setValueSelector: setSel.
+ minimumValue := Float negativeInfinity.
+ maximumValue := Float infinity.
+ quantum := nil.
+ value := model perform: getValueSelector.
+
+ minValueOrSel isSymbol
+ ifTrue: [self getMinimumValueSelector: minValueOrSel; getMinimumValue]
+ ifFalse: [self minimumValue: minValueOrSel].
+ maxValueOrSel isSymbol
+ ifTrue: [self getMaximumValueSelector: maxValueOrSel; getMaximumValue]
+ ifFalse: [self maximumValue: maxValueOrSel].
+ quantumValueOrSel isSymbol
+ ifTrue: [self getQuantumSelector: quantumValueOrSel; getQuantum]
+ ifFalse: [self quantum: quantumValueOrSel].
+ self setValue: self getValue.
+
+ self computeSlider.
Slider>>update: {updating} · ct 12/28/2022 17:01 (changed)
update: aSymbol
"Update the value."
super update: aSymbol.
aSymbol = self getValueSelector ifTrue: [self getValue. ^ self].
aSymbol = self getMinimumValueSelector ifTrue: [self getMinimumValue. ^ self].
- aSymbol = self getMaximumValueSelector ifTrue: [self getMaximumValue. ^ self].
+ aSymbol = self getMaximumValueSelector ifTrue: [self getMaximumValue. ^ self].
+ aSymbol = self getQuantumSelector ifTrue: [self getQuantum. ^ self].
SliderDemoModel
+ Model subclass: #SliderDemoModel
+ instanceVariableNames: 'value minValue maxValue quantum'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'MorphicExtras-Demo-ToolBuilder'
+
+ SliderDemoModel class
+ instanceVariableNames: ''
+
+ "I demonstrate how to use the PluggableSliderSpec."
SliderDemoModel class>>open {opening} · ct 12/28/2022 20:20
+ open
+
+ ^ self new open
SliderDemoModel>>buildWith: {toolbuilder} · ct 12/28/2022 18:18
+ buildWith: aBuilder
+
+ | spec |
+ spec := self buildWindowWith: aBuilder specs: {
+ (0 @ 0 rect: 1 @ 0.1) -> [aBuilder pluggableSliderSpec new
+ model: self;
+ getValue: #currentValue;
+ setValue: #currentValue:;
+ minValue: #minValue;
+ maxValue: #maxValue;
+ quantum: #quantum;
+ interval: 0.1;
+ help: 'slider';
+ color: Color blue;
+ yourself].
+ (0 @ 0.1 rect: 1 / 4 @ 0.2) -> [aBuilder pluggableTextSpec new
+ model: self;
+ getText: #valueText;
+ setText: #valueText:;
+ help: 'value';
+ yourself].
+ (1 / 4 @ 0.1 rect: 2 / 4 @ 0.2) -> [aBuilder pluggableTextSpec new
+ model: self;
+ getText: #minValueText;
+ setText: #minValueText:;
+ help: 'min';
+ yourself].
+ (2 / 4 @ 0.1 rect: 3 / 4 @ 0.2) -> [aBuilder pluggableTextSpec new
+ model: self;
+ getText: #maxValueText;
+ setText: #maxValueText:;
+ help: 'max';
+ yourself].
+ (3 / 4 @ 0.1 rect: 4 / 4 @ 0.2) -> [aBuilder pluggableTextSpec new
+ model: self;
+ getText: #quantumText;
+ setText: #quantumText:;
+ help: 'quantum';
+ yourself] }.
+ ^ aBuilder build: spec
SliderDemoModel>>currentValue {accessing} · ct 12/28/2022 16:55
+ currentValue
+
+ ^ value
SliderDemoModel>>currentValue: {accessing} · ct 12/28/2022 17:13
+ currentValue: aNumber
+
+ value := aNumber.
+ self changed: #currentValue; changed: #valueText.
SliderDemoModel>>initialize {initialize-release} · ct 12/28/2022 17:14
+ initialize
+
+ super initialize.
+ value := 15.
+ minValue := 10.
+ maxValue := 20.
+ quantum := 0.1.
SliderDemoModel>>maxValue {accessing} · ct 12/28/2022 17:03
+ maxValue
+
+ ^ maxValue
SliderDemoModel>>maxValue: {accessing} · ct 12/28/2022 17:07
+ maxValue: aNumber
+
+ maxValue := aNumber.
+ self changed: #maxValue; changed: #maxValueText.
SliderDemoModel>>maxValueText {accessing - text} · ct 12/28/2022 17:02
+ maxValueText
+
+ ^ self maxValue asString
SliderDemoModel>>maxValueText: {accessing - text} · ct 12/28/2022 17:07
+ maxValueText: aStringOrText
+
+ self maxValue: aStringOrText asNumber.
+ ^ true
SliderDemoModel>>minValue {accessing} · ct 12/28/2022 17:02
+ minValue
+
+ ^ minValue
SliderDemoModel>>minValue: {accessing} · ct 12/28/2022 17:08
+ minValue: aNumber
+
+ minValue := aNumber.
+ self changed: #minValue; changed: #minValueText.
SliderDemoModel>>minValueText {accessing - text} · ct 12/28/2022 17:02
+ minValueText
+
+ ^ self minValue asString
SliderDemoModel>>minValueText: {accessing - text} · ct 12/28/2022 17:08
+ minValueText: aStringOrText
+
+ self minValue: aStringOrText asNumber.
+ ^ true
SliderDemoModel>>open {toolbuilder} · ct 12/28/2022 20:20
+ open
+
+ ^ ToolBuilder default open: self
SliderDemoModel>>quantum {accessing} · ct 12/28/2022 17:03
+ quantum
+
+ ^ quantum
SliderDemoModel>>quantum: {accessing} · ct 12/28/2022 17:09
+ quantum: aNumber
+
+ quantum := aNumber.
+ self changed: #quantum; changed: #quantumText.
SliderDemoModel>>quantumText {accessing - text} · ct 12/28/2022 17:03
+ quantumText
+
+ ^ self quantum asString
SliderDemoModel>>quantumText: {accessing - text} · ct 12/28/2022 17:09
+ quantumText: aStringOrText
+
+ self quantum: aStringOrText asNumber.
+ ^ true
SliderDemoModel>>valueText {accessing - text} · ct 12/28/2022 17:06
+ valueText
+
+ ^ self currentValue printShowingDecimalPlaces: 2
SliderDemoModel>>valueText: {accessing - text} · ct 12/28/2022 16:56
+ valueText: aStringOrText
+
+ self currentValue: aStringOrText asNumber.
+ ^ true
ToolBuilder>>buildPluggableSlider: {widgets required} · ct 12/28/2022 20:06
+ buildPluggableSlider: spec
+
+ ^ self subclassResponsibility
ToolBuilder>>pluggableSliderSpec {defaults} · ct 2/10/2020 11:14
+ pluggableSliderSpec
+ ^ PluggableSliderSpec
---
Sent from Squeak Inbox Talk
["pluggableSlider.6.cs"]
["SliderDemoModel.png"]