[ENH][WIDGET]RangeSliderMorph widget
Russell Swan
swan at dandenong.cs.umass.edu
Sat Mar 18 03:09:58 UTC 2000
Attached is a changeset that implements a RangeSlider widget in Morphic.
RangeSliders differ from regular sliders in that they have two sliders on
one track, and are used to specify a range of values rather than a single
value. Ben Shneiderman uses them frequently (see his Dynamic Queries paper
- he shows 3 or 4 systems and everyone uses a rangeslider). They're rather
specialized, but they're very good for their specific application.
The demo examples in RangeSliderMorph require the ScaleMorph changeset I
posted earlier today.
I don't know where they belong in the image - Widgets, Demos, Experimental
- I'll let SqC figure that out. I'd appreciate any feedback,especially on
look & feel. Overall I think I got the feel right, but they don't look
that good. Some people can make good looking widgets by properly
specifiyng #raised and #inset for borderColor and setting the width right,
but my stuff never looks very good.
-Russell Swan
-------------- next part --------------
ScaleMorph subclass: #ArrayScale
instanceVariableNames: 'boundaryCollection labelCollection model rectColors rectsAbove handlesMouseFlag '
classVariableNames: ''
poolDictionaries: ''
category: 'RangeSlider'!
!ArrayScale commentStamp: '<historical>' prior: 0!
I am a variant on a ScaleMorph. My initialization arguments are an ordered array of numeric values, where my MajorTicks are drawn, and an ordered array with one less element of labels. I am useful for doing calendars and timelines, where the major ticks would be on month breaks. I have optional fields for drawing myself in different colors, above or below the tick marks.!
!ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 23:23'!
drawStories
^ self.! !
!ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 16:31'!
findOffset
" Calculates how many pixels above the bottom are used for tickMarks,
labels, captions, etc.
Area from self top to (self bottom - yoffset) can be used for drawing.
Return yoffset"
| yoffset randomLabel |
yoffset _ majorTickLength abs + 2.
caption
ifNotNil: [randomLabel _ StringMorph contents: 'Foo'.
yoffset _ yoffset + randomLabel height + 2].
tickPrintBlock
ifNotNil: [randomLabel _ StringMorph contents: '50'.
yoffset _ yoffset + randomLabel height + 2].
^ yoffset! !
!ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 21:16'!
handlesMouseDown: evt
handlesMouseFlag isNil ifTrue:[ ^ false ].
^ handlesMouseFlag.! !
!ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 21:15'!
handlesMouseFlag: aBoolean
handlesMouseFlag _ aBoolean.! !
!ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 23:16'!
model: anObject
"Set my model and make me me a dependent of the given object."
model ifNotNil: [model removeDependent: self].
anObject ifNotNil: [anObject addDependent: self].
model _ anObject! !
!ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 14:59'!
rectsAbove: aBoolean
rectsAbove _ aBoolean.! !
!ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 23:17'!
update: someArgs
"Transcript show: 'In ArrayScaleMorph>>update:, numArgs is ', someArgs
size asString,
someArgs first, someArgs third asString; cr."
someArgs first = #stopSlider ifTrue: [self stop: someArgs third + 1].
someArgs first = #startSlider ifTrue: [self start: someArgs third]! !
!ArrayScale methodsFor: 'drawing' stamp: 'RCS 3/16/2000 17:25'!
buildLabels
"morphic stuff here"
| scale x1 y1 y2 x ta tb xa xb t tickMorph tickStart tickStop startNum offSet yoffset captionMorph yyoffset |
self removeAllMorphs.
yyoffset _ 2.
caption
ifNotNil:
[captionMorph _ StringMorph contents: caption.
captionAbove
ifTrue: [yoffset _ majorTickLength abs + captionMorph height + 7]
ifFalse:
[yoffset _ 2.
yyoffset _ yyoffset + captionMorph height].
captionMorph align: captionMorph bounds bottomCenter with: self bounds bottomCenter - (0 @ yoffset).
self addMorph: captionMorph].
labelsAbove ifTrue: [yyoffset _ yyoffset + 2 + majorTickLength abs].
start >= stop ifTrue: [^ self].
scale _ self innerBounds width - 1 / (stop - start) asFloat.
x1 _ self innerBounds left.
y1 _ self innerBounds bottom - yyoffset.
y2 _ y1 - (1.5 * majorTickLength).
1 to: labelCollection size do:
[:v |
ta _ boundaryCollection at: v.
tb _ boundaryCollection at: v + 1.
ta > stop | (tb < start)
ifFalse:
[ta < start
ifTrue:
[xa _ x1.
tickStart _ start]
ifFalse:
[xa _ x1 + (scale * (ta - start)).
tickStart _ ta].
tb > stop
ifTrue:
[xb _ self innerBounds right.
tickStop _ stop]
ifFalse:
[xb _ x1 + (scale * (tb - start)).
tickStop _ tb].
t _ xa + xb.
x _ t / 2.0.
xb - xa > 50
ifTrue:
[tickMorph _ StringMorph contents: (labelCollection at: v).
tickMorph align: tickMorph bounds bottomCenter with: x @ (y1 - 1).
tickMorph left < self left ifTrue: [tickMorph position: self left @ tickMorph top].
tickMorph right > self right ifTrue: [tickMorph position: self right - tickMorph width @ tickMorph top].
self addMorph: tickMorph].
"Range labels (months) filled in. Do individual days if total
range is small enough"
stop - start < 50
ifTrue:
["Draw individual dates in, instead of just months"
x _ x1 + (scale / 2.0).
"(tickStart = start) ifFalse: ["
offSet _ tickStart - start.
x _ x + (scale * offSet).
startNum _ tickStart - ta + 1.
tickStart to: tickStop - 1 do:
[:q |
tickMorph _ StringMorph contents: startNum printString.
tickMorph align: tickMorph bounds bottomCenter with: x @ y2.
self addMorph: tickMorph.
startNum _ startNum + 1.
x _ x + scale
"]."]]]].
self drawStories! !
!ArrayScale methodsFor: 'drawing' stamp: 'RCS 3/16/2000 15:58'!
drawMajorTicksOn: aCanvas
| scale x1 y1 y2 x loopStart ytop yup yoffset randomLabel |
start >= stop ifTrue: [^ self].
"First draw minor ticks"
scale _ self innerBounds width - 1 / (stop - start) asFloat.
majorTickLength < 0
ifTrue: [yoffset _ majorTickLength abs + 1]
ifFalse: [yoffset _ 1].
caption
ifNotNil: [captionAbove
ifFalse:
[randomLabel _ StringMorph contents: 'Foo'.
yoffset _ yoffset + randomLabel height + 2]].
tickPrintBlock
ifNotNil: [labelsAbove
ifFalse:
[randomLabel _ StringMorph contents: '50'.
yoffset _ yoffset + randomLabel height + 2]].
x1 _ self innerBounds left.
y1 _ self innerBounds bottom - yoffset.
y2 _ y1 - majorTickLength.
ytop _ self innerBounds top.
"Now draw major ticks on boundaries"
boundaryCollection do: [:num | num > start & (num < stop)
ifTrue:
[x _ x1 + (scale * (num - start)).
aCanvas
line: x @ y1
to: x @ y2
width: 1
color: Color black]].
scale _ self innerBounds width - 1 / (stop - start) asFloat.
x1 _ self innerBounds left.
y1 _ self innerBounds bottom.
yup _ y1 - 30.
y2 _ y1 - majorTickLength.
stop - start < 50
ifTrue:
[loopStart _ (start / minorTick) ceiling * minorTick.
loopStart
to: stop
by: minorTick
do:
[:v |
x _ x1 + (scale * (v - start)).
aCanvas
line: x @ yup
to: x @ ytop
width: 1
color: Color white]]! !
!ArrayScale methodsFor: 'drawing' stamp: 'RCS 3/16/2000 15:47'!
drawOn: aCanvas
self drawRectsOn: aCanvas.
self drawTicksOn: aCanvas! !
!ArrayScale methodsFor: 'drawing' stamp: 'RCS 3/16/2000 16:18'!
drawRectsOn: aCanvas
| scale x1 x loopStart rect ytop yup ta tb xa xb vmod ybot offset |
rectColors isNil ifTrue: [^ self].
rectColors size < 2 ifTrue: [^ self].
start >= stop ifTrue: [^ self].
aCanvas
frameAndFillRectangle: self bounds
fillColor: color
borderWidth: 1
borderColor: Color black.
scale _ self innerBounds width - 1 / (stop - start) asFloat.
offset _ self findOffset.
x1 _ self innerBounds left.
yup _ self innerBounds bottom - offset.
"y2 _ y1 + minorTickLength."
ytop _ self innerBounds top.
ybot _ self innerBounds bottom.
scale _ self innerBounds width - 1 / (stop - start) asFloat.
x1 _ self innerBounds left.
"y1 _ self innerBounds bottom.
yup _ y1 - 30.
y2 _ y1 - majorTickLength."
1 to: labelCollection size do:
[:v |
ta _ boundaryCollection at: v.
tb _ boundaryCollection at: v + 1.
ta > stop | (tb < start)
ifFalse:
["self halt."
ta < start
ifTrue: [xa _ x1]
ifFalse: [xa _ x1 + (scale * (ta - start))].
tb > stop
ifTrue: [xb _ self innerBounds right]
ifFalse: [xb _ x1 + (scale * (tb - start))].
rectsAbove
ifTrue: [rect _ Rectangle origin: xa @ ytop corner: xb @ yup]
ifFalse: [rect _ Rectangle origin: xa @ yup corner: xb @ ybot].
vmod _ v \\ rectColors size.
vmod = 0 ifTrue: [vmod _ rectColors size].
aCanvas fillRectangle: rect color: (rectColors at: vmod)]].
stop - start < 50
ifTrue:
[loopStart _ (start / minorTick) ceiling * minorTick.
loopStart
to: stop
by: minorTick
do:
[:v |
x _ x1 + (scale * (v - start)).
aCanvas
line: x @ yup
to: x @ ytop
width: 1
color: Color white]]! !
!ArrayScale methodsFor: 'initialization' stamp: 'RCS 3/16/2000 14:34'!
setBoundary: bCollection andLabels: lCollection
self setBoundary: bCollection andLabels: lCollection andColors: nil.
! !
!ArrayScale methodsFor: 'initialization' stamp: 'RCS 3/16/2000 15:50'!
setBoundary: bCollection andLabels: lCollection andColors: colorCollection
boundaryCollection _ bCollection.
labelCollection _ lCollection.
rectColors _ colorCollection.
rectsAbove _ true.
super
start: bCollection first
stop: bCollection last
minorTick: 1
minorTickLength: 3
majorTick: 10
majorTickLength: -10.
" tickPrintBlock isn't used, but I need to make room for labels"
self tickPrintBlock: [:v | v asString].
self labelsAbove: false! !
Model subclass: #RangeSlider
instanceVariableNames: 'begin end oldBegin oldEnd minValue maxValue delta midValue roundTo target actionSelector actionBlock '
classVariableNames: ''
poolDictionaries: ''
category: 'RangeSlider'!
!RangeSlider commentStamp: '<historical>' prior: 0!
I am the model for the RangeSliderMorph. I hold minValue, begin, end, and maxValue and enforce minValue <= begin < end <= maxValue. I also have a roundTo parameter so I can be used for discrete stepping. If there is a target I send actionSelector to target with the value of a codeblock taking 2 arguments, begin and end.!
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/13/2000 14:41'!
begin
^ begin.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 21:10'!
begin: newNumber
| aNumber |
roundTo isNil
ifTrue: [aNumber _ newNumber]
ifFalse: [aNumber _ newNumber roundTo: roundTo].
aNumber < minValue
ifFalse: [aNumber > (maxValue - delta)
ifFalse:
[begin _ aNumber.
begin > (end - delta) ifTrue: [end _ begin + delta]]].
self notifyTarget.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 11:34'!
beginAsRatio
^ ( (begin - minValue) / (maxValue - minValue) ) asFloat.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 11:41'!
beginAsRatio: aNumber
self begin: aNumber * self range + self minValue! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/13/2000 14:44'!
end
^ end.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 21:10'!
end: newNumber
| aNumber |
roundTo isNil
ifTrue: [aNumber _ newNumber]
ifFalse: [aNumber _ newNumber roundTo: roundTo].
aNumber < (minValue - delta)
ifFalse: [aNumber > maxValue
ifFalse:
[end _ aNumber.
end < (begin + delta) ifTrue: [begin _ end - delta]]].
self notifyTarget.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 11:34'!
endAsRatio
^ ( (end - minValue) / (maxValue - minValue) ) asFloat.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 11:39'!
endAsRatio: aNumber
self end: (aNumber * self range) + self minValue.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 15:11'!
initialize
minValue _ 0.0.
maxValue _ 100.0.
begin _ 0.0.
end _ 100.0.
delta _ 0.01.
! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/14/2000 17:52'!
maxValue
^ maxValue! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 14:52'!
maxValue: aNumber
maxValue _ aNumber.
end _ aNumber.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 11:58'!
midValue: aNumber
midValue _ aNumber* self range..
oldBegin _ begin.
oldEnd _ end! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/14/2000 17:53'!
minValue
^ minValue! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 14:52'!
minValue: aNumber
minValue _ aNumber.
begin _ aNumber.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 21:11'!
moveTo: aRatio
| offset aNumber tempOffset |
aNumber _ aRatio * self range.
tempOffset _ aNumber - midValue.
roundTo isNil
ifTrue: [offset _ tempOffset]
ifFalse: [offset _ tempOffset roundTo: roundTo].
"Check to make sure don't run off edge"
oldBegin + offset < minValue ifTrue: [offset _ minValue - oldBegin].
oldEnd + offset > maxValue ifTrue: [offset _ maxValue - oldEnd].
begin _ oldBegin + offset.
end _ oldEnd + offset.
self notifyTarget.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 18:21'!
notifyTarget
| begString endString string args |
((target isNil or: [actionSelector isNil])
or: [actionBlock isNil])
ifFalse:
[args _ Array with: begin with: end.
string _ actionBlock valueWithArguments: args.
target perform: actionSelector with: string]! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 11:40'!
range
^ maxValue - minValue.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/15/2000 11:51'!
roundTo
^ roundTo.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 15:12'!
roundTo: aNumber
roundTo _ aNumber.
delta_ aNumber.! !
!RangeSlider methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 18:01'!
target: aMorph withSelector: action andBlock: aBlock
target _ aMorph.
actionSelector _ action.
actionBlock _ aBlock.! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
RangeSlider class
instanceVariableNames: ''!
!RangeSlider class methodsFor: 'instance creation' stamp: 'RCS 3/14/2000 11:59'!
new
^ super new initialize.! !
BorderedMorph subclass: #RangeSliderMorph
instanceVariableNames: 'frame begSlider endSlider midSlider rangeSlider scale trough begSliderShadow endSliderShadow midSliderShadow sliderColor '
classVariableNames: ''
poolDictionaries: ''
category: 'RangeSlider'!
!RangeSliderMorph commentStamp: '<historical>' prior: 0!
I am a RangeSliderMorph. I am used to specify two values, and my semantics are all values between the high and low values. My model is a RangeSlider which enforces
[minimumValue <= lowValue <= highValue <= maximumValue]. I can accept a ScaleMorph as a subMorph.!
!RangeSliderMorph methodsFor: 'initialization' stamp: 'RCS 3/17/2000 21:36'!
initializeBegSlider
| col vertices |
col _ OrderedCollection new.
col add: 10 @ 0;
add: 10 @ 35;
add: 0 @ 25;
add: 0 @ 3;
add: 1 @ 1;
add: 3 @ 0.
vertices _ Array newFrom: col.
begSlider _ SmallPolygonMorph
vertices: vertices
color: Color gray
borderWidth: 2
borderColor: #raised.
"begSlider position: 110 @ 95.
begSliderShadow _ SliderHandle new.
begSliderShadow position: 110 @ 100."
begSliderShadow _ SmallPolygonMorph
vertices: vertices
color: Color gray
borderWidth: 1
borderColor: #inset.
begSlider
on: #mouseStillDown
send: #scrollAbsolute:whichMorph:flag:
to: self
withValue: #begin.
begSlider
on: #mouseDown
send: #mouseDownInSlider:whichMorph:flag:
to: self
withValue: #begin.
begSlider
on: #mouseUp
send: #mouseUpInSlider:whichMorph:flag:
to: self
withValue: #begin.
"begSlider setBorderWidth: 1 borderColor: #raised.
begSliderShadow setBorderWidth: 1 borderColor: #inset."
"(the shadow must have the pagingArea as its owner to highlight
properly)"
"self pagingArea addMorph: sliderShadow."
self addMorph: begSliderShadow.
begSliderShadow hide.
self addMorph: begSlider.
self computeBegSlider! !
!RangeSliderMorph methodsFor: 'initialization' stamp: 'RCS 3/17/2000 15:40'!
initializeEndSlider
| col vertices |
col _ OrderedCollection new.
col add: 0 @ 0;
add: 0 @ 35;
add: 10 @ 25;
add: 10 @ 3;
add: 9 @ 1;
add: 7 @ 0.
vertices _ Array newFrom: col.
endSlider _ SmallPolygonMorph
vertices: vertices
color: Color gray
borderWidth: 2
borderColor: #raised.
endSliderShadow _ SmallPolygonMorph
vertices: vertices
color: Color gray
borderWidth: 1
borderColor: #inset.
endSlider
on: #mouseStillDown
send: #scrollAbsolute:whichMorph:flag:
to: self
withValue: #end.
endSlider
on: #mouseDown
send: #mouseDownInSlider:whichMorph:flag:
to: self
withValue: #end.
endSlider
on: #mouseUp
send: #mouseUpInSlider:whichMorph:flag:
to: self
withValue: #end.
"endSlider setBorderWidth: 1 borderColor: #raised.
endSliderShadow setBorderWidth: 1 borderColor: #inset."
"(the shadow must have the pagingArea as its owner to highlight
properly)"
"self pagingArea addMorph: sliderShadow."
self addMorph: endSliderShadow.
endSliderShadow hide.
self addMorph: endSlider.
self computeEndSlider.! !
!RangeSliderMorph methodsFor: 'initialization' stamp: 'RCS 3/17/2000 21:36'!
initializeMidSlider
midSlider _ RectangleMorph newBounds: self trough innerBounds color: Color lightGray.
midSliderShadow _ RectangleMorph newBounds: midSlider bounds color: self color.
midSlider
on: #mouseStillDown
send: #scrollAbsolute:whichMorph:flag:
to: self
withValue: #mid.
midSlider
on: #mouseDown
send: #mouseDownInSlider:whichMorph:flag:
to: self
withValue: #mid.
midSlider
on: #mouseUp
send: #mouseUpInSlider:whichMorph:flag:
to: self
withValue: #mid.
midSlider setBorderWidth: 1 borderColor: #raised.
midSliderShadow setBorderWidth: 1 borderColor: #inset.
"(the shadow must have the pagingArea as its owner to highlight
properly)"
self addMorph: midSliderShadow.
midSliderShadow hide.
self addMorph: midSlider.
self computeMidSlider! !
!RangeSliderMorph methodsFor: 'initialization' stamp: 'RCS 3/17/2000 21:35'!
openAsMorph
super initialize.
rangeSlider _ RangeSlider new.
bounds _ 0 @ 0 corner: 100 @ 50.
color _ Color transparent.
borderWidth _ 0.
trough _ RectangleMorph new.
trough bounds: (0 @ 0 corner: 100 @ 10).
trough color: Color gray.
trough borderWidth: 1.
trough borderColor: #inset.
self addMorph: trough.
self initializeMidSlider.
self initializeBegSlider.
self initializeEndSlider.
self openInWorld! !
!RangeSliderMorph methodsFor: 'initialization' stamp: 'RCS 3/17/2000 21:35'!
openAsMorphFromScale: aScale
| newExtent |
"Take the scale submorph as input and build myself around it."
super initialize.
scale _ aScale.
rangeSlider _ RangeSlider new minValue: aScale start; maxValue: aScale stop.
newExtent _ (scale extent) max: (100@ 50).
Transcript show: scale extent asString, ' ', newExtent asString; cr.
bounds _ scale position corner: (scale position + newExtent).
color _ Color transparent.
borderWidth _ 0.
trough _ RectangleMorph new.
trough bounds: (aScale position corner: newExtent x @ 10).
trough color: Color gray.
trough borderWidth: 1.
trough borderColor: #inset.
self addMorph: scale.
self addMorph: trough.
self initializeMidSlider.
self initializeBegSlider.
self initializeEndSlider.
"(scale extent = self extent ) ifFalse:[self extent: self extent]."
self extent: self extent.
self openInWorld! !
!RangeSliderMorph methodsFor: 'accessing' stamp: 'RCS 3/17/2000 21:32'!
setRoundTo: aNumber
rangeSlider roundTo: aNumber.! !
!RangeSliderMorph methodsFor: 'accessing' stamp: 'RCS 3/14/2000 10:53'!
sliderColor
sliderColor ifNil: [^ Color veryLightGray].
^ sliderColor! !
!RangeSliderMorph methodsFor: 'accessing' stamp: 'RCS 3/14/2000 10:53'!
sliderColor: newColor
sliderColor _ newColor! !
!RangeSliderMorph methodsFor: 'accessing' stamp: 'RCS 3/14/2000 11:23'!
sliderExtent
^ bounds isWide
ifTrue: [self sliderThickness @ self innerBounds height]
ifFalse: [self innerBounds width @ self sliderThickness]! !
!RangeSliderMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 11:29'!
sliderThickness
^ 10! !
!RangeSliderMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 11:29'!
totalSliderArea
^ self trough innerBounds! !
!RangeSliderMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 11:27'!
trough
^ trough.! !
!RangeSliderMorph methodsFor: 'scrolling' stamp: 'RCS 3/17/2000 14:19'!
mouseDownInSlider: event whichMorph: aMorph flag: aSymbol
| r p |
aMorph color: self sliderColor lighter.
aSymbol = #begin
ifTrue:
[begSliderShadow bounds: begSlider bounds.
begSliderShadow show].
aSymbol = #end
ifTrue:
[endSliderShadow bounds: endSlider bounds.
endSliderShadow show].
aSymbol = #mid
ifTrue:
[r _ self roomToMove.
bounds isWide
ifTrue: [r width = 0 ifTrue: [^ self]]
ifFalse: [r height = 0 ifTrue: [^ self]].
p _ event targetPoint adhereTo: r.
rangeSlider midValue: (p x - r left) asFloat / r width.
midSliderShadow bounds: midSlider bounds.
midSliderShadow show.
begSliderShadow bounds: begSlider bounds.
begSliderShadow show.
endSliderShadow bounds: endSlider bounds.
endSliderShadow show]! !
!RangeSliderMorph methodsFor: 'scrolling' stamp: 'RCS 3/14/2000 18:26'!
mouseUpInSlider: event whichMorph: aMorph flag: aSymbol
aMorph color: self sliderColor.
aSymbol = #begin ifTrue: [begSliderShadow hide].
aSymbol = #end ifTrue: [endSliderShadow hide].
aSymbol = #mid ifTrue: [midSliderShadow hide.
begSliderShadow hide.
endSliderShadow hide.].! !
!RangeSliderMorph methodsFor: 'scrolling' stamp: 'RCS 3/17/2000 14:22'!
moveMiddleBy: aValue
"Drive the slider position externally..."
rangeSlider moveTo: aValue.
self computeSliders! !
!RangeSliderMorph methodsFor: 'scrolling' stamp: 'RCS 3/17/2000 12:30'!
scrollAbsolute: event whichMorph: aMorph flag: aSymbol
"self halt."
| r p shiftRect |
r _ self roomToMove.
bounds isWide
ifTrue: [r width = 0 ifTrue: [^ self]]
ifFalse: [r height = 0 ifTrue: [^ self]].
p _ event targetPoint adhereTo: r.
aSymbol = #begin ifTrue: [self setBegValue: (bounds isWide
ifTrue:
[shiftRect _ Rectangle origin: r left - begSlider width @ r top corner: r corner.
p _ event targetPoint adhereTo: shiftRect.
(p x - r left + begSlider width) asFloat / r width]
ifFalse: [
shiftRect _ Rectangle origin: r left width @ r top - begSlider corner: r corner.
p _ event targetPoint adhereTo: shiftRect.
(p y - r top) asFloat / r height + begSlider width])].
aSymbol = #end ifTrue: [self setEndValue: (bounds isWide
ifTrue: [(p x - r left) asFloat / r width]
ifFalse: [(p y - r top) asFloat / r height])].
aSymbol = #mid ifTrue: [self moveMiddleBy: (bounds isWide
ifTrue: [(p x - r left) asFloat / r width]
ifFalse: [(p y - r top) asFloat / r height])]! !
!RangeSliderMorph methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 14:19'!
setTarget: aMorph withSelector: action andBlock: aBlock
rangeSlider
target: aMorph
withSelector: action
andBlock: aBlock! !
!RangeSliderMorph methodsFor: 'geometry' stamp: 'RCS 3/17/2000 14:23'!
computeBegSlider
| r value |
r _ self roomToMove.
value _ rangeSlider beginAsRatio.
begSlider position: (bounds isWide
ifTrue: [r topLeft + ((r width * value) asInteger @ 0) - (begSlider bounds width @ 5)]
ifFalse: [r topLeft + (0 @ (r height * value) asInteger) - (5 @ begSlider bounds height)])! !
!RangeSliderMorph methodsFor: 'geometry' stamp: 'RCS 3/17/2000 14:22'!
computeEndSlider
| r value |
r _ self roomToMove.
value _ rangeSlider endAsRatio.
endSlider position: (bounds isWide
ifTrue: [r topLeft + ((r width * value) asInteger @ 0) - (1 @ 5)]
ifFalse: [r topLeft + (0 @ (r height * value) asInteger) - (5 @ 1)])! !
!RangeSliderMorph methodsFor: 'geometry' stamp: 'RCS 3/17/2000 14:22'!
computeMidSlider
| r begValue endValue |
r _ self roomToMove.
begValue _ rangeSlider beginAsRatio.
midSlider position: (bounds isWide
ifTrue: [r topLeft + ((r width * begValue) asInteger @ 0)]
ifFalse: [r topLeft + (0 @ (r height * begValue) asInteger)]).
endValue _ rangeSlider endAsRatio.
midSlider extent: (bounds isWide
ifTrue: [(r width * (endValue - begValue)) asInteger @ trough innerBounds height]
ifFalse: [trough innerBounds width @ (r height * (endValue - begValue)) asInteger])! !
!RangeSliderMorph methodsFor: 'geometry' stamp: 'RCS 3/14/2000 18:20'!
computeSliders
self computeMidSlider.
self computeEndSlider.
self computeBegSlider.! !
!RangeSliderMorph methodsFor: 'geometry' stamp: 'RCS 3/17/2000 16:05'!
extent: proposedExtent
| x y newExtent |
scale isNil
ifTrue: [newExtent _ proposedExtent]
ifFalse: [newExtent _ scale checkExtent: proposedExtent].
super extent: newExtent + (5 @ 5).
x _ newExtent x.
y _ (newExtent y / 5) asInteger.
trough extent: x @ y.
midSlider height: trough innerBounds height.
y _ (newExtent y * 7 / 10) asInteger.
x _ 10 max: (y / 5) asInteger.
begSlider extent: x @ y.
begSliderShadow extent: x @ y.
endSlider extent: x @ y.
endSliderShadow extent: x @ y.
scale isNil
ifFalse: [ scale extent: proposedExtent ].
self computeSliders! !
!RangeSliderMorph methodsFor: 'geometry' stamp: 'RCS 3/17/2000 12:00'!
roomToMove
| rect |
"rect _ self totalSliderArea.
^ Rectangle origin: rect left - 10 @ rect top corner: rect corner"
^ self totalSliderArea! !
!RangeSliderMorph methodsFor: 'submorphs-accessing' stamp: 'RCS 3/17/2000 14:19'!
begValue: newValue
"Drive the slider position externally..."
rangeSlider beginAsRatio: newValue.
self computeSliders! !
!RangeSliderMorph methodsFor: 'submorphs-accessing' stamp: 'RCS 3/17/2000 14:19'!
endValue: newValue
"Drive the slider position externally..."
rangeSlider endAsRatio: newValue.
self computeSliders! !
!RangeSliderMorph methodsFor: 'submorphs-accessing' stamp: 'RCS 3/14/2000 14:31'!
setBegValue: newValue
"Called internally for propagation to model"
self begValue: newValue! !
!RangeSliderMorph methodsFor: 'submorphs-accessing' stamp: 'RCS 3/14/2000 15:41'!
setEndValue: newValue
"Called internally for propagation to model"
self endValue: newValue! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
RangeSliderMorph class
instanceVariableNames: ''!
!RangeSliderMorph class methodsFor: 'as yet unclassified' stamp: 'RCS 3/17/2000 21:34'!
openAsMorph
^ self new openAsMorph! !
!RangeSliderMorph class methodsFor: 'examples' stamp: 'RCS 3/17/2000 14:32'!
basic
^ self new openAsMorph! !
!RangeSliderMorph class methodsFor: 'examples' stamp: 'RCS 3/17/2000 21:44'!
calendar
| myInst string scale dayBounds months colors |
dayBounds _ OrderedCollection new.
months _ OrderedCollection new.
colors _ OrderedCollection new.
dayBounds add: 1;
add: 31;
add: 59;
add: 90;
add: 120;
add: 151;
add: 181.
months add: 'January';
add: 'February';
add: 'March';
add: 'April';
add: 'May';
add: 'June'.
colors add: Color lightBlue; add: Color lightYellow.
scale _ (ArrayScale new setBoundary: dayBounds andLabels: months andColors: colors)
bounds: (30 @ 30 corner: 400 @ 90).
scale labelsAbove: false; rectsAbove: false.
myInst _ RangeSliderMorph new openAsMorphFromScale:scale.
string _ (StringMorph contents: 'Calendar') position: 150 @ 150;
openInWorld.
myInst
setTarget: string
withSelector: #contents:
andBlock:
[:a :b | | date dd1 dd2 |
date _ Date newDay: 365 year: 1998.
dd1 _ date addDays: a asInteger.
dd2 _ date addDays: b asInteger.
'From ' , dd1 monthName , ' ' , dd1 dayOfMonth asString , ' to ' , dd2 monthName , ' ' , dd2 dayOfMonth asString, ' ', dd2 year asString].
^ myInst! !
!RangeSliderMorph class methodsFor: 'examples' stamp: 'RCS 3/17/2000 21:33'!
housePrices
| scale myInst string |
scale _ (ScaleMorph new
start: 100000
stop: 600000
minorTick: 10000
minorTickLength: 2
majorTick: 100000
majorTickLength: 10
caption: nil
tickPrintBlock: [:v | '$' , v asString]
labelsAbove: false
captionAbove: false) bounds: (10 @ 50 corner: 200 @ 100);
color: Color veryVeryLightGray; labelsAbove: false.
myInst _ RangeSliderMorph new openAsMorphFromScale:scale.
myInst setRoundTo: 20000.
string _ (StringMorph contents: 'Houses') position: 150 @ 150;
openInWorld.
myInst
setTarget: string
withSelector: #contents:
andBlock:
[:a :b | 'Houses from $', a asInteger asString, ' to $', b asInteger asString.].
^ myInst! !
PolygonMorph subclass: #SmallPolygonMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'RangeSlider'!
!SmallPolygonMorph commentStamp: '<historical>' prior: 0!
I am a basic PolygonMorph without a minimum size hardcoded in #extent:!
!SmallPolygonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 3/14/2000 23:21'!
extent: newExtent
"Override extent: in parent to get rid of 20 at 20 minimum size"
self setVertices: (vertices collect: [:p | p - bounds topLeft * (newExtent asFloatPoint / (bounds extent max: 1 @ 1)) + bounds topLeft])! !
More information about the Squeak-dev
mailing list
|