[ENH][WIDGET]RangeSliderMorph widgetRussell Swan swan at dandenong.cs.umass.eduSat 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 |