[ENH] ScaleMorph

Russell Swan swan at dandenong.cs.umass.edu
Fri Mar 17 17:18:24 UTC 2000


Modified ScaleMorph. Added some options on appearance, so most times a
ScaleMorph would be used, should be able to use as is without subclassing.
Also split #drawOn: into multiple submethods for a subclass I've been
using. New interface is a strict superset of old interface so nothing
should break.

-Russell Swan
-------------- next part --------------
'From Squeak2.7 of 5 January 2000 [latest update: #1762] on 17 March 2000 at 1:08:21 pm'!
RectangleMorph subclass: #ScaleMorph
	instanceVariableNames: 'caption start stop minorTick minorTickLength majorTick majorTickLength tickPrintBlock labelsAbove captionAbove '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!
!ScaleMorph commentStamp: '<historical>' prior: 0!
Rewrite of ScaleMorph - March 2000 (Russell Swan). Added accessors. Added two Booleans, labelsAbove and captionAbove. Determines where the labels and captions print, if they exist. Tick marks can either go up or down. For ticks going up, put in majorTickLength > 0. Negative value will make ticks go down. Examples on Class side.!


!ScaleMorph methodsFor: 'drawing' stamp: 'RCS 3/15/2000 23:01'!
buildLabels
	| scale x1 y1 y2 x captionMorph tickMorph loopStart offset |
	((majorTickLength * minorTickLength) < 0) ifTrue: [minorTickLength _ 0 - minorTickLength].
	self removeAllMorphs.
	caption
		ifNotNil: 
			[captionMorph _ StringMorph contents: caption.
			captionAbove
				ifTrue: [offset _ majorTickLength abs + captionMorph height + 7]
				ifFalse: [offset _ 2].
			captionMorph align: captionMorph bounds bottomCenter with: self bounds bottomCenter - (0 @ offset).
			self addMorph: captionMorph].
	tickPrintBlock
		ifNotNil: 
			["Calculate the offset for the labels, depending on whether or not 
			  1) there's a caption   
			below, 2) the labels are above or below the ticks, and 3) the   
			ticks go up or down"
			labelsAbove
				ifTrue: [offset _ majorTickLength abs + minorTickLength abs + 2]
				ifFalse: [offset _ 2].
			caption
				ifNotNil: [captionAbove ifFalse: [offset _ offset + captionMorph height + 2]].
			scale _ self innerBounds width - 1 / (stop - start) asFloat.
			x1 _ self innerBounds left.
			y1 _ self innerBounds bottom.
			y2 _ y1 - offset.
			"Start loop on multiple of majorTick"
			loopStart _ (start / majorTick) ceiling * majorTick.
			loopStart
				to: stop
				by: majorTick
				do: 
					[:v | 
					x _ x1 + (scale * (v - start)).
					tickMorph _ StringMorph contents: (tickPrintBlock value: v).
					tickMorph align: tickMorph bounds bottomCenter with: x @ y2.
					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]]! !

!ScaleMorph methodsFor: 'drawing' stamp: 'RCS 3/16/2000 14:18'!
drawMajorTicksOn: aCanvas 
	| scale x1 y1 y2 x y3 even yy loopStart checkStart yoffset randomLabel |
	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.
	y3 _ y1 - (minorTickLength + majorTickLength // 2).
	even _ true.
	"Make sure major ticks start drawing on a multiple of majorTick"
	loopStart _ (start / majorTick) ceiling * majorTick.
	checkStart _ (start / (majorTick / 2.0)) ceiling * majorTick.
	"Check to see if semimajor tick should be drawn before majorTick"
	checkStart = (loopStart * 2)
		ifFalse: 
			[loopStart _ checkStart / 2.0.
			even _ false].
	loopStart
		to: stop
		by: majorTick / 2.0
		do: 
			[:v | 
			x _ x1 + (scale * (v - start)).
			yy _ even
						ifTrue: [y2]
						ifFalse: [y3].
			aCanvas
				line: x @ y1
				to: x @ yy
				width: 1
				color: Color black.
			even _ even not]! !

!ScaleMorph methodsFor: 'drawing' stamp: 'RCS 3/16/2000 14:16'!
drawMinorTicksOn: aCanvas 
	| scale x1 y1 y2 x loopStart yoffset randomLabel |
	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 - minorTickLength.
	loopStart _ (start / minorTick) ceiling * minorTick.
	loopStart
		to: stop
		by: minorTick
		do: 
			[:v | 
			x _ x1 + (scale * (v - start)).
			aCanvas
				line: x @ y1
				to: x @ y2
				width: 1
				color: Color black].
	! !

!ScaleMorph methodsFor: 'drawing' stamp: 'RCS 3/15/2000 21:36'!
drawOn: aCanvas 
	| |
	super drawOn: aCanvas.
	
	self drawTicksOn: aCanvas.! !

!ScaleMorph methodsFor: 'drawing' stamp: 'RCS 3/16/2000 14:19'!
drawTicksOn: aCanvas 
	self drawMajorTicksOn: aCanvas.
	self drawMinorTicksOn: aCanvas! !


!ScaleMorph methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 00:43'!
initialize
	super initialize.
	borderWidth _ 0.
	color _ Color lightGreen.
	start _ 0.
	stop _ 100.
	minorTick _ 1.
	majorTick _ 10.
	minorTickLength _ 3.
	majorTickLength _ 10.
	caption _ nil.
	tickPrintBlock _ [:v | v printString].
	labelsAbove _ true.
	captionAbove _ true! !

!ScaleMorph methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 14:55'!
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen

	self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: nil tickPrintBlock: nil
	! !

!ScaleMorph methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 14:54'!
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk 
	self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: true captionAbove: true.
	! !

!ScaleMorph methodsFor: 'as yet unclassified' stamp: 'RCS 3/16/2000 15:09'!
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: aBoolean captionAbove: notherBoolean 
	start _ strt.
	stop _ stp.
	minorTick _ mnt.
	minorTickLength _ mntLen.
	majorTick _ mjt.
	majorTickLength _ mjtLen.
	caption _ cap.
	tickPrintBlock _ blk.
	labelsAbove _ aBoolean.
	captionAbove _ notherBoolean.
	self buildLabels! !


!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:41'!
caption
	^ caption.! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:42'!
caption: aString
	caption _ aString.! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/16/2000 00:38'!
captionAbove: aBoolean 
	captionAbove _ aBoolean! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/16/2000 00:38'!
labelsAbove: aBoolean
	labelsAbove _ aBoolean.! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:46'!
majorTickLength: anInteger 
	majorTickLength _ anInteger! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:46'!
minorTickLength: anInteger
	minorTickLength _ anInteger.! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:43'!
start
	^ start! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:43'!
start: aNumber
	start _ aNumber.! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:43'!
stop
	^ stop! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:44'!
stop: aNumber
	stop _ aNumber.! !

!ScaleMorph methodsFor: 'accessing' stamp: 'RCS 3/15/2000 21:47'!
tickPrintBlock: aBlock
	tickPrintBlock _ aBlock.! !


!ScaleMorph methodsFor: 'geometry' stamp: 'RCS 3/16/2000 13:58'!
checkExtent: newExtent 
	| pixPerTick newWidth |
	pixPerTick _ newExtent x - (self borderWidth * 2) - 1 / ((stop - start) asFloat / minorTick).
	pixPerTick _ pixPerTick
				detentBy: 0.1
				atMultiplesOf: 1.0
				snap: false.
	newWidth _ pixPerTick * ((stop - start) asFloat / minorTick) + (self borderWidth * 2) + 1.
	^ (newWidth @ newExtent y).! !

!ScaleMorph methodsFor: 'geometry' stamp: 'RCS 3/16/2000 13:59'!
extent: newExtent 
	| modExtent |
	modExtent _ self checkExtent: newExtent.
	super extent: modExtent.
	self buildLabels! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ScaleMorph class
	instanceVariableNames: ''!

!ScaleMorph class methodsFor: 'examples' stamp: 'RCS 3/17/2000 12:48'!
example1
	"Example 1 captions and labels above, ticks point up"
	^ (self new
		start: 0
		stop: 150
		minorTick: 1
		minorTickLength: 2
		majorTick: 10
		majorTickLength: 10
		caption: 'Example 1'
		tickPrintBlock: [:v | v printString]) openInWorld! !

!ScaleMorph class methodsFor: 'examples' stamp: 'RCS 3/17/2000 12:49'!
example2
	"Example 2 captions and labels above, ticks point down"
	^ (self new
		start: 0
		stop: 150
		minorTick: 1
		minorTickLength: 2
		majorTick: 10
		majorTickLength: -10
		caption: 'Example 2'
		tickPrintBlock: [:v | v printString]) openInWorld! !

!ScaleMorph class methodsFor: 'examples' stamp: 'RCS 3/17/2000 12:55'!
example3
	"Example 3 caption above, labels below, ticks point down"
	^ ((self new
		start: -23
		stop: 47
		minorTick: 1
		minorTickLength: 2
		majorTick: 10
		majorTickLength: -10
		caption: 'Example 3'
		tickPrintBlock: [:v | v printString]
		labelsAbove: false
		captionAbove: true)
		color: Color lightBlue) openInWorld! !

!ScaleMorph class methodsFor: 'examples' stamp: 'RCS 3/17/2000 12:59'!
example4
	"Example 4 caption below, labels above, ticks point up"
	^ ((self new
		start: 100000
		stop: 300000
		minorTick: 5000
		minorTickLength: 2
		majorTick: 50000
		majorTickLength: 10
		caption: 'Example 4'
		tickPrintBlock: [:v | '$' , v printString]
		labelsAbove: true
		captionAbove: false)
		color: Color lightOrange) openInWorld! !


More information about the Squeak-dev mailing list