[etoys-dev] Etoys: MorphicExtras-kfr.59.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Mar 3 10:36:09 EST 2012


Karl Ramberg uploaded a new version of MorphicExtras to project Etoys:
http://source.squeak.org/etoys/MorphicExtras-kfr.59.mcz

==================== Summary ====================

Name: MorphicExtras-kfr.59
Author: kfr
Time: 3 March 2012, 4:36:20 pm
UUID: b64cdf3d-fa28-f349-bf9a-4208ffa4f2b2
Ancestors: MorphicExtras-kfr.58

Add number lines, for use both in cuisanaire-rod-like applications and as axes for cartesian planes and graphs.

=============== Diff against MorphicExtras-kfr.58 ===============

Item was changed:
  SystemOrganization addCategory: #'MorphicExtras-AdditionalMorphs'!
  SystemOrganization addCategory: #'MorphicExtras-AdditionalSupport'!
  SystemOrganization addCategory: #'MorphicExtras-AdditionalWidgets'!
  SystemOrganization addCategory: #'MorphicExtras-Books'!
  SystemOrganization addCategory: #'MorphicExtras-Demo'!
  SystemOrganization addCategory: #'MorphicExtras-EToy-Download'!
  SystemOrganization addCategory: #'MorphicExtras-Flaps'!
  SystemOrganization addCategory: #'MorphicExtras-GeeMail'!
  SystemOrganization addCategory: #'MorphicExtras-Leds'!
  SystemOrganization addCategory: #'MorphicExtras-Navigators'!
  SystemOrganization addCategory: #'MorphicExtras-Obsolete'!
  SystemOrganization addCategory: #'MorphicExtras-Palettes'!
  SystemOrganization addCategory: #'MorphicExtras-PartsBin'!
  SystemOrganization addCategory: #'MorphicExtras-Postscript Canvases'!
  SystemOrganization addCategory: #'MorphicExtras-Postscript Filters'!
  SystemOrganization addCategory: #'MorphicExtras-SoundInterface'!
  SystemOrganization addCategory: #'MorphicExtras-SqueakPage'!
  SystemOrganization addCategory: #'MorphicExtras-Support'!
  SystemOrganization addCategory: #'MorphicExtras-Text Support'!
  SystemOrganization addCategory: #'MorphicExtras-Undo'!
  SystemOrganization addCategory: #'MorphicExtras-Widgets'!
  SystemOrganization addCategory: #'MorphicExtras-WebCam'!
+ SystemOrganization addCategory: #'MorphicExtras-Charts'!

Item was added:
+ ----- Method: HaloMorph>>openViewerForTarget:with: (in category '*morphicExtras-Charts') -----
+ openViewerForTarget: evt with: aHandle
+ 	"Open  a viewer for my inner target"
+ 
+ 	self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
+ 	evt  shiftPressed
+ 		ifTrue:
+ 			[target assuredPlayer tearOffAttachedWatcherFor: #getLocationOnGraph]
+ 		ifFalse:
+ 			[innerTarget openViewerForArgument]!

Item was added:
+ NumberLineMorph subclass: #HorizontalNumberLineMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'MorphicExtras-Charts'!
+ 
+ !HorizontalNumberLineMorph commentStamp: 'sw 2/15/2012 21:01' prior: 0!
+ A number line horizontally oriented.!

Item was added:
+ ----- Method: HorizontalNumberLineMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description for use in parts bins"
+ 
+ 	^ self
+ 		partName: 'H number line' translatedNoop
+ 		categories: {'Graphing' translatedNoop}
+ 		documentation: 'A horizontal number line.  One possible use is as an x-axis in a graph.' translatedNoop!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>addLegendsAndMarks (in category 'initialization') -----
+ addLegendsAndMarks
+ 	"Add legends and tick-marks."
+ 
+ 	| index offset current n legendCenter markCenter aMark aLegend |
+ 	minValue ifNil: ["too early" ^ self].
+ 
+ 	index := 0.
+ 	offset := self offset.
+ 	(submorphs copyWithout: axis) do: [:m | m delete].
+ 	current := self left + offset.
+ 	[current < (self right - offset)] whileTrue:
+ 		[n := minValue + index.
+ 		(n isDivisibleBy: unitsPerMark) ifTrue:
+ 			[markCenter := current @ (self top + (self marksHeight / 2)).
+ 			aMark := self newMark.
+ 			self addMorph: aMark.
+ 			aMark center: markCenter; color: self color.
+ 
+ 			(n isDivisibleBy: self marksPerLegend) ifTrue:
+ 				[(n ~= 0 or: [showZero]) ifTrue:
+ 					[legendCenter := current @ (self top + self marksHeight + (self legendsHeight / 2)) + (0 @ 2).
+ 					aLegend := StringMorph contents: n asString.
+ 					self addMorph: aLegend.
+ 					aLegend center: legendCenter; color: self color]]].
+ 			current := current + pixelsPerUnit.
+ 			index := index + 1].
+ 	^ index!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>asValidExtent: (in category 'initialization') -----
+ asValidExtent: newExtent 
+ 	^ (newExtent x max: 100)
+ 		@ (self marksHeight + self legendsHeight)!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>centerOfAxisVertex: (in category 'initialization') -----
+ centerOfAxisVertex: n 
+ 	n = 1
+ 		ifTrue: [^ self left @ (self top + self marksHeight)].
+ 	n = 2
+ 		ifTrue: [^ self right @ (self top + self marksHeight)].
+ 	^ self error: 'Invalid vertex'!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>fitPlayfield (in category 'initialization') -----
+ fitPlayfield
+ 	"Currently unused and not yet really correct... the idea is to have a command whose result will be that the number line will expand or contract as needed such that the line exactly fills the horizontal space of its containing playfield.   A similar item would be wanted for vertical axes as well..."
+ 
+ 	| aPlayfield |
+ 	aPlayfield := self referencePlayfield.
+ 	"find a value that is currently on screen."
+ 	self minValue: (self horizontalCoordinateForX: 0) ceiling.
+ 	self maxValue: (self horizontalCoordinateForX: aPlayfield right) truncated!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>horizontalCoordinateForX: (in category 'coordinates') -----
+ horizontalCoordinateForX: xPixelValue
+ 	"Answer the horizontal coordinate, in the metric embodied in the number line at hand, corresponding to a given x pixel-coordinate."
+ 
+ 	| start origin |
+ 	start := self left + self offset.
+ 	origin := start + (0 - minValue * pixelsPerUnit).
+ 	^ xPixelValue - origin / pixelsPerUnit!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>horizontalCoordinateOf: (in category 'coordinates') -----
+ horizontalCoordinateOf: anObject
+ 	"Answer the horizontal coordinate of the center of a given object in the number-line's metric space."
+ 
+ 	anObject ifNil:  [^ 0].
+ 	^ self horizontalCoordinateForX: anObject center x!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self extent: 600 @ self allowance!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>maxValue (in category 'accessing') -----
+ maxValue
+ 	"Answer the maximum value represented at the positive end of the receiver."
+ 
+ 	^ minValue + (self width - self allowance / pixelsPerUnit) rounded!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>maxValue: (in category 'accessing') -----
+ maxValue: aNumber
+ 	"Establish the maximum value represented.  This is done by extending or contracting the receiver."
+ 
+ 	self width: (aNumber - minValue * pixelsPerUnit) rounded + self allowance + ((self widthOfString: aNumber asString)
+ 				/ 2)!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>minValue: (in category 'accessing') -----
+ minValue: aNumber
+ 	"Establish the value corresponding to the lowest end of the line."
+ 
+ 	| diff |
+ 	diff := self minValue - aNumber.
+ 	self bounds: (self bounds withLeft: self bounds left - (self pixelsPerUnit * diff)).
+ 	super minValue: aNumber!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>newMark (in category 'initialization') -----
+ newMark
+ 	^ Morph new extent: 2 @ self marksHeight!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>placeLegendsAndMarks: (in category 'initialization') -----
+ placeLegendsAndMarks: aBlock
+ 	"Place the legends and tick-marks. The block provided has four arguments: :index :n :legendCenter :markCenter"
+ 
+ 	| index offset current n legendCenter markCenter |
+ 	index := 0.
+ 	offset := self offset.
+ 	current := self left + offset.
+ 	[current < (self right - offset)]
+ 		whileTrue: [n := minValue + index.
+ 			index := index + 1.
+ 			(index - 1 isDivisibleBy: increment)
+ 				ifTrue: [legendCenter := current @ (self top + self marksHeight + (self legendsHeight / 2)) + (0 @ 2).
+ 					markCenter := current @ (self top + (self marksHeight / 2)).
+ 					aBlock valueWithArguments: {index. n. legendCenter. markCenter}].
+ 			current := current + pixelsPerUnit].
+ 	^ index!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>registerGraphCoordinate:atPlayfieldLocation: (in category 'initialization') -----
+ registerGraphCoordinate: aGraphCoordinate atPlayfieldLocation: desiredPlayfieldCoordinate
+ 	"Fine-tuning for perfect registry."
+ 
+ 	| itsCurrentOnPlayfield delta |
+ 	itsCurrentOnPlayfield := ((aGraphCoordinate - minValue) * pixelsPerUnit) + self left + self offset. "relative to playfield's left edge"
+ 	delta := (desiredPlayfieldCoordinate - itsCurrentOnPlayfield) + owner left.
+ 	self left: self left + delta.
+ 	self update!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>setXOnGraphFor:to: (in category 'coordinates') -----
+ setXOnGraphFor: aMorph to: aNumber
+ 	"Position a morph horizontally such that its xOnGraph, given the current horizontal axis in play, is as indicated."
+ 
+ 	| start |
+ 	start := self left + self offset.
+ 	aMorph center: start + (aNumber - minValue * pixelsPerUnit) @ aMorph center y!

Item was added:
+ ----- Method: Morph>>addGraphLocationPlotter (in category '*MorphicExtras-accessing') -----
+ addGraphLocationPlotter
+ 	"Create an unlabeled watcher on the locationOnGraph of the object and give it a ticking tick that keeps it clinging beneath the watchee wherever it goes.  "
+ 
+ 	| aWatcher |
+ 	aWatcher := FollowingWatcher new buildForPlayer: self topRendererOrSelf assuredPlayer getter: #getLocationOnGraph.
+ 	aWatcher firstSubmorph beTransparent; borderWidth: 0.
+ 	aWatcher beTransparent; borderWidth: 0.
+ 	aWatcher attachmentEdge: #bottom.
+ 	aWatcher openInWorld!

Item was added:
+ ----- Method: Morph>>addMiscExtrasTo: (in category '*MorphicExtras-menus') -----
+ addMiscExtrasTo: aMenu
+ 	"Add a submenu of miscellaneous extra items to the menu."
+ 
+ 	| realOwner realMorph subMenu |
+ 	subMenu _ MenuMorph new defaultTarget: self.
+ 	(Preferences eToyFriendly not and: [self isWorldMorph not and: [self renderedMorph isSystemWindow not]])
+ 		ifTrue: [subMenu add: 'put in a window' translated action: #embedInWindow].
+ 
+ 	self isWorldMorph ifFalse:
+ 		[subMenu add: 'adhere to edge...' translated action: #adhereToEdge.
+ 		subMenu addLine].
+ 
+ 	realOwner _ (realMorph _ self topRendererOrSelf) owner.
+ 	(realOwner isKindOf: TextPlusPasteUpMorph) ifTrue:
+ 		[subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)].
+ 
+ 	Preferences eToyFriendly
+  ifFalse: [
+ 		subMenu
+ 	
+ 		add: 'add mouse up action' translated action: #addMouseUpAction;
+ 	
+ 		add: 'remove mouse up action' translated action: #removeMouseUpAction;
+ 	
+ 		add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire.
+ 	
+ 	subMenu addLine.
+ 	].
+ 
+ 	Preferences eToyFriendly
+  ifFalse: [
+ 		subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads.
+ 	
+ 	subMenu addLine.
+ 	
+ ].
+ 	subMenu defaultTarget: self topRendererOrSelf.
+ 	(self isWorldMorph not and: [(self renderedMorph isSystemWindow) not]) ifTrue: [
+ 		subMenu add: 'draw new path' translated action: #definePath.
+ 	
+ 	subMenu add: 'follow existing path' translated action: #followPath.
+ 	
+ 	subMenu add: 'delete existing path' translated action: #deletePath.
+ 	
+ 	subMenu addLine.
+ 	].
+ 	self addGestureMenuItems: subMenu hand: ActiveHand.
+ 
+ 
+ 	self isWorldMorph ifFalse:
+ 		[subMenu add: 'graph-location plotter' translated action: #handUserGraphLocationPlotter.
+ 		subMenu add: 'graph-location follower' translated action: #addGraphLocationPlotter.
+ 		subMenu add: 'balloon help for this object' translated action: #editBalloonHelpText].
+ 
+ 	subMenu submorphs isEmpty ifFalse: [
+ 		aMenu add: 'extras...' translated subMenu: subMenu
+ 	].!

Item was added:
+ ----- Method: Morph>>handUserGraphLocationPlotter (in category '*MorphicExtras-accessing') -----
+ handUserGraphLocationPlotter
+ 	"Create a watcher on the locationOnGraph of the object and hand it to the user."
+ 
+ 	(WatcherWrapper new fancyForPlayer: self topRendererOrSelf assuredPlayer getter: #getLocationOnGraph) openInHand!

Item was added:
+ Morph subclass: #NumberLineMorph
+ 	instanceVariableNames: 'minValue increment actualColor axis legends marks showZero pixelsPerUnit unitsPerMark marksPerLegend'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'MorphicExtras-Charts'!
+ 
+ !NumberLineMorph commentStamp: 'sw 2/15/2012 21:00' prior: 0!
+ An abstract superclass for VerticalNumberLine and HorizontalNumberLine.
+ 
+ minValue - Number - the value corresponding to the left edge of the line.
+ increment - Number - the space along the line between individual legends/marks
+ pixelsPerUnit - Integer - the number of pixels on the graph that correspond to a single unit in the metric space of the line.
+ actualColor - th 
+ axis - a two-vertex PolygonMorph which is the actual line
+ legends - a list of the legends showing values along the line.
+ marks - a list of the tick-marks along the axis.
+ showZero - Boolean - if false, then a 0 legend will *not* be show.!

Item was added:
+ ----- Method: NumberLineMorph class>>additionsToViewerCategoryNumberLine (in category 'viewer categories') -----
+ additionsToViewerCategoryNumberLine
+ 	^ #('number line' (
+ 	"	(command fitPlayfield 'extend or contract such that the line fits within the containing playfield.')"
+ 		(slot minVal 'smallest value shown on the axis' Number readWrite Player getMinVal Player setMinVal:)
+ 		(slot maxVal 'largest value shown on the axis' Number readWrite Player getMaxVal Player setMaxVal:)
+ 
+ 		(slot pixelsPerUnit 'number of screen pixels per unit on the number line' Number readWrite Player getPixelsPerUnit Player setPixelsPerUnit:)
+ 		(slot unitsPerMark 'number of units between tick marks on the number line' Number readWrite Player getUnitsPerMark Player setUnitsPerMark:)
+ 		(slot marksPerLegend 'number of ticks between successive legends' Number readWrite Player getMarksPerLegend Player setMarksPerLegend:)
+ 
+ 		(slot showZero 'whether to show the numeral 0 at the zero point on this axis' Boolean readWrite Player getShowZero Player setShowZero:)
+ 		(slot showNegativeArrowHead 'whether to show an arrow-head at the extreme left edge of the axis' Boolean readWrite Player getShowNegativeArrowHead Player setShowNegativeArrowHead:)) )!

Item was added:
+ ----- Method: NumberLineMorph class>>from:by:pixelsPerUnit: (in category 'instance creation') -----
+ from: minValue by: increment pixelsPerUnit: pixelsPerUnit 
+ 	^ (self basicNew
+ 		setMinValue: minValue
+ 		increment: increment
+ 		pixelsPerUnit: pixelsPerUnit) initialize!

Item was added:
+ ----- Method: NumberLineMorph class>>from:pixelsPerUnit:unitsPerMark:marksPerLegend: (in category 'instance creation') -----
+ from: minValue pixelsPerUnit: pixelsPerUnit  unitsPerMark: unitsPerMark marksPerLegend: marksPerLegend
+ 
+ 	^ (self new
+ 			minValue: minValue pixelsPerUnit: pixelsPerUnit unitsPerMark: unitsPerMark marksPerLegend: marksPerLegend)!

Item was added:
+ ----- Method: NumberLineMorph class>>newStandAlone (in category 'instance creation') -----
+ newStandAlone
+ 
+ 	^ (self from: -10 pixelsPerUnit: 30 unitsPerMark: 1 marksPerLegend: 1) update; yourself!

Item was added:
+ ----- Method: NumberLineMorph>>addCustomMenuItems:hand: (in category 'halo menu') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Use my line's menu additions"
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 	aMenu addLine.
+ 
+ 	aMenu addList: {
+ 		{'set pixels per unit' translated. 			#choosePixelsPerUnit.			'set the number of pixels per unit on the number line.' translated}.
+ 		{'set units per mark' translated.	#chooseUnitsPerMark.	'set the number of units between marks on the number line.' translated}.
+ 		{'set marks per legend' translated.	#chooseMarksPerLegend.	'set the number of units between tick marks on the number line.' translated}.
+ 
+ 		{'set max value' translated.	#chooseMaxValue. 	'set the maximum value to be shown on the number line.' translated}.
+ 		{'set min value' translated . 	#chooseMinValue.		'set the minimum value shown on the number line.' translated}}.
+ 
+ 	aMenu
+ 		addUpdating: #showingNegativeArrowHeadPhrase target: self action: #toggleNegativeArrowHead;
+ 		addUpdating: #showingZeroPhrase target: self action: #toggleShowingZero..
+ 
+ !

Item was added:
+ ----- Method: NumberLineMorph>>allowance (in category 'visual properties') -----
+ allowance
+ 	"Answer the allowance for overhead -- put here to avoid hard-coding the number in multiple other places..."
+ 
+ 	^ 50!

Item was added:
+ ----- Method: NumberLineMorph>>asValidExtent: (in category 'abstract') -----
+ asValidExtent: newExtent 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>centerOfAxisVertex: (in category 'abstract') -----
+ centerOfAxisVertex: n 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>chooseMarksPerLegend (in category 'halo menu') -----
+ chooseMarksPerLegend
+ 	"Put up a dialog disclosing the current increment and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'marksPerLegend' translated initialAnswer: self marksPerLegend printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self marksPerLegend: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>chooseMaxValue (in category 'halo menu') -----
+ chooseMaxValue
+ 	"Put up a dialog showing the current maxValue and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'type new max value' initialAnswer: self maxValue printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self maxValue: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>chooseMinValue (in category 'halo menu') -----
+ chooseMinValue
+ 	"Put up a dialog disclosing the current minValue and allowing the user to specify a new value for it."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'type new min value' initialAnswer: self minValue printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self minValue: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>choosePixelsPerUnit (in category 'halo menu') -----
+ choosePixelsPerUnit
+ 	"Put up a dialog showing the current pixelsPerUnit and allowing the user to submit a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'type new pixels per unit' translated initialAnswer: pixelsPerUnit printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self pixelsPerUnit: result asNumber!

Item was added:
+ ----- Method: NumberLineMorph>>chooseTicksPerLegend (in category 'halo menu') -----
+ chooseTicksPerLegend
+ 	"Put up a dialog disclosing the current increment and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'ticksPerLegend' translated initialAnswer: self ticksPerLegend printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self ticksPerLegend: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>chooseUnitsPerMark (in category 'menu') -----
+ chooseUnitsPerMark
+ 	"Put up a dialog disclosing the current unitsPerMark and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'unitsPerMark' translated initialAnswer: self unitsPerMark printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self unitsPerMark: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>chooseUnitsPerTick (in category 'halo menu') -----
+ chooseUnitsPerTick
+ 	"Put up a dialog disclosing the current unitsPerTick and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'units per tick' translated initialAnswer: self unitsPerTick printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self unitsPerTick: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>color (in category 'accessing') -----
+ color
+ 	^ actualColor!

Item was added:
+ ----- Method: NumberLineMorph>>color: (in category 'accessing') -----
+ color: aColor 
+ 	actualColor := aColor.
+ 	super color: Color transparent.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>extent: (in category 'accessing') -----
+ extent: newExtent 
+ 	super
+ 		extent: (self asValidExtent: newExtent).
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>fillStyle: (in category 'accessing') -----
+ fillStyle: aFillStyle 
+ 	self color: aFillStyle asColor!

Item was added:
+ ----- Method: NumberLineMorph>>increment (in category 'accessing') -----
+ increment
+ 	^ increment!

Item was added:
+ ----- Method: NumberLineMorph>>increment: (in category 'accessing') -----
+ increment: aNumber 
+ 	increment := aNumber max: 0.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Basic initialization."
+ 
+ 	super initialize.
+ 	actualColor := Color black.
+ 	axis := PolygonMorph arrowPrototype arrowSpec: 8 @ 4;
+ 				 lineBorderWidth: 1.
+ 	legends := OrderedCollection new.
+ 	marks := OrderedCollection new.
+ 	pixelsPerUnit := 40.
+ 	unitsPerMark := 5.
+ 	marksPerLegend := 1.
+ 	showZero := true.
+ 	minValue := 0.
+ 	self addMorph: axis;
+ 		 color: actualColor.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>legendsHeight (in category 'accessing') -----
+ legendsHeight
+ 	^ TextStyle defaultFont height!

Item was added:
+ ----- Method: NumberLineMorph>>legendsWidth (in category 'accessing') -----
+ legendsWidth
+ 	^ (self widthOfString: self minValue asString)
+ 		max: (self widthOfString: self maxValue asString)!

Item was added:
+ ----- Method: NumberLineMorph>>marksHeight (in category 'accessing') -----
+ marksHeight
+ 	^ 5!

Item was added:
+ ----- Method: NumberLineMorph>>marksPerLegend (in category 'accessing') -----
+ marksPerLegend
+ 	"Answer the value of marksPerLegend."
+ 
+ 	^ marksPerLegend!

Item was added:
+ ----- Method: NumberLineMorph>>marksPerLegend: (in category 'halo menu') -----
+ marksPerLegend: aNumber
+ 	"Set the value of marksPerLegend."
+ 
+ 	marksPerLegend := aNumber rounded max: 1.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>marksWidth (in category 'accessing') -----
+ marksWidth
+ 	^ 5!

Item was added:
+ ----- Method: NumberLineMorph>>maxVal (in category 'accessing') -----
+ maxVal
+ 	^ self maxValue!

Item was added:
+ ----- Method: NumberLineMorph>>maxValue (in category 'accessing') -----
+ maxValue
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>minVal (in category 'accessing') -----
+ minVal
+ 	^ self minValue!

Item was added:
+ ----- Method: NumberLineMorph>>minValue (in category 'accessing') -----
+ minValue
+ 	^ minValue!

Item was added:
+ ----- Method: NumberLineMorph>>minValue: (in category 'accessing') -----
+ minValue: aNumber 
+ 	minValue := aNumber.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>minValue:pixelsPerUnit:unitsPerMark:marksPerLegend: (in category 'initialization') -----
+ minValue: minInteger pixelsPerUnit: ppuInteger unitsPerMark: upmInteger marksPerLegend: mplInteger 
+ 	"Initialize the receiver to have the given minimum value, pixelsPerUnit, unitsPerMark, and marksPerLegend"
+ 
+ 	minValue := minInteger.
+ 	pixelsPerUnit := ppuInteger.
+ 	unitsPerMark := upmInteger.
+ 	marksPerLegend := mplInteger!

Item was added:
+ ----- Method: NumberLineMorph>>newMark (in category 'abstract') -----
+ newMark
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>offset (in category 'visual properties') -----
+ offset
+ 	^ 25!

Item was added:
+ ----- Method: NumberLineMorph>>pixelsPerUnit (in category 'accessing') -----
+ pixelsPerUnit
+ 	"Answer the number of pixels per unit in the receiver's metric system."
+ 
+ 	^ pixelsPerUnit!

Item was added:
+ ----- Method: NumberLineMorph>>pixelsPerUnit: (in category 'accessing') -----
+ pixelsPerUnit: aNumber
+ 	"Set the number of pixels that will constitute one 'unit' along the receiver.  Retain existing min and max values."
+ 
+ 	| newPixelsPerUnit existingMax |
+ 	(newPixelsPerUnit := aNumber max: 1) = pixelsPerUnit
+ 		ifTrue: [^ self].
+ 
+ 	existingMax := self maxValue.
+ 	pixelsPerUnit := newPixelsPerUnit.
+ 	self update.
+ 	self maxValue: existingMax!

Item was added:
+ ----- Method: NumberLineMorph>>placeAxis (in category 'updating') -----
+ placeAxis
+ 	1
+ 		to: 2
+ 		do: [:i | axis vertices
+ 				at: i
+ 				put: (self centerOfAxisVertex: i)].
+ 	axis borderColor: self color.
+ 	axis computeBounds!

Item was added:
+ ----- Method: NumberLineMorph>>placeLegendsAndMarks (in category 'updating') -----
+ placeLegendsAndMarks
+ 	| usedLegends usedMarks unusedLegends unusedMarks legend mark |
+ 	usedLegends := OrderedCollection new.
+ 	usedMarks := OrderedCollection new.
+ 	self
+ 		placeLegendsAndMarks: [:index :n :legendCenter :markCenter | 
+ 			(n ~= 0
+ 					or: [showZero])
+ 				ifTrue: [legend := usedLegends
+ 								add: (legends
+ 										at: index
+ 										ifAbsent: [legends add: StringMorph new]).
+ 					self addMorph: legend.
+ 					legend contents: n asString;
+ 						 center: legendCenter;
+ 						 color: self color].
+ 			mark := usedMarks
+ 						add: (marks
+ 								at: index
+ 								ifAbsent: [marks add: self newMark]).
+ 			self addMorph: mark.
+ 			mark center: markCenter;
+ 				 color: self color].
+ 	unusedLegends := legends copyWithoutAll: usedLegends.
+ 	unusedLegends
+ 		do: [:each | each delete].
+ 	legends removeAll: unusedLegends.
+ 	unusedMarks := marks copyWithoutAll: usedMarks.
+ 	unusedMarks
+ 		do: [:each | each delete].
+ 	marks removeAll: unusedMarks!

Item was added:
+ ----- Method: NumberLineMorph>>placeLegendsAndMarks: (in category 'abstract') -----
+ placeLegendsAndMarks: aBlock 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>setMaxVal: (in category 'accessing') -----
+ setMaxVal: aNumber 
+ 	self maxValue: aNumber!

Item was added:
+ ----- Method: NumberLineMorph>>setMinVal: (in category 'accessing') -----
+ setMinVal: aNumber 
+ 	self minValue: aNumber!

Item was added:
+ ----- Method: NumberLineMorph>>setMinValue:increment:pixelsPerUnit: (in category 'initialization') -----
+ setMinValue: minValue1 increment: increment1 pixelsPerUnit: pixelsPerUnit1
+ 	"Initialize the receiver to have the given minimum value, increment and pixelsPerUnit"
+ 
+ 	minValue := minValue1.
+ 	increment := increment1.
+ 	pixelsPerUnit := pixelsPerUnit1!

Item was added:
+ ----- Method: NumberLineMorph>>showNegativeArrowHead (in category 'accessing') -----
+ showNegativeArrowHead
+ 	^ axis arrows = #both!

Item was added:
+ ----- Method: NumberLineMorph>>showNegativeArrowHead: (in category 'accessing') -----
+ showNegativeArrowHead: aBoolean 
+ 	aBoolean
+ 		ifTrue: [axis makeBothArrows]
+ 		ifFalse: [axis makeForwardArrow]!

Item was added:
+ ----- Method: NumberLineMorph>>showZero (in category 'accessing') -----
+ showZero
+ 	^ showZero!

Item was added:
+ ----- Method: NumberLineMorph>>showZero: (in category 'accessing') -----
+ showZero: aBoolean 
+ 	showZero := aBoolean.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>showingNegativeArrowHeadPhrase (in category 'halo menu') -----
+ showingNegativeArrowHeadPhrase
+ 	"Answer a phrase representing whether or not the receiver is currently showing an arrowhead at its negative end."
+ 
+ 	^ (self showNegativeArrowHead ifTrue: ['<yes>'] ifFalse: ['<no>']), 'show negative arrowhead' translated!

Item was added:
+ ----- Method: NumberLineMorph>>showingZeroPhrase (in category 'halo menu') -----
+ showingZeroPhrase
+ 	"Answer a phrase telling whether or not the legend for the zero-point should be shown on the axis."
+ 
+ 	^ (showZero ifTrue: ['<yes>'] ifFalse: ['<no>']), 'show legend for the zero point.' translated!

Item was added:
+ ----- Method: NumberLineMorph>>ticksPerLegend: (in category 'halo menu') -----
+ ticksPerLegend: aNumber
+ 	marksPerLegend := aNumber rounded max: 1!

Item was added:
+ ----- Method: NumberLineMorph>>toggleNegativeArrowHead (in category 'halo menu') -----
+ toggleNegativeArrowHead
+ 	"Toggle the setting of the flag governing whether the negative-direction arrowhead should be shown."
+ 
+ 	self showNegativeArrowHead: self showNegativeArrowHead not!

Item was added:
+ ----- Method: NumberLineMorph>>toggleShowingZero (in category 'halo menu') -----
+ toggleShowingZero
+ 	"Toggle the setting of the flag that governs whether the zero-point legend should be shown."
+ 
+ 	self showZero: self showZero not!

Item was added:
+ ----- Method: NumberLineMorph>>unitsPerMark (in category 'accessing') -----
+ unitsPerMark
+ 	^ unitsPerMark!

Item was added:
+ ----- Method: NumberLineMorph>>unitsPerMark: (in category 'accessing') -----
+ unitsPerMark: anInteger
+ 	unitsPerMark := anInteger.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>update (in category 'updating') -----
+ update
+ 	minValue ifNotNil:
+ 		[self placeAxis; addLegendsAndMarks]!

Item was added:
+ ----- Method: NumberLineMorph>>widthOfString: (in category 'accessing') -----
+ widthOfString: aString 
+ 	^ TextStyle defaultFont widthOfString: aString!

Item was added:
+ ----- Method: PasteUpMorph class>>descriptionForPartsBin (in category '*MorphicExtras-parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Playfield' translatedNoop
+ 		categories:		{'Basic' translatedNoop. 'Graphing' translatedNoop}
+ 		documentation:	'A place for assembling parts or for staging animations' translatedNoop!

Item was added:
+ NumberLineMorph subclass: #VerticalNumberLineMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'MorphicExtras-Charts'!
+ 
+ !VerticalNumberLineMorph commentStamp: 'sw 2/15/2012 21:01' prior: 0!
+ A number line vertically oriented.!

Item was added:
+ ----- Method: VerticalNumberLineMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description for use in parts bins"
+ 
+ 	^ self
+ 		partName: 'V number line' translatedNoop
+ 		categories: {'Graphing' translatedNoop}
+ 		documentation: 'A vertical number line.  One possible use is as a y-axis in a graph.' translatedNoop!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>addLegendsAndMarks (in category 'initialization') -----
+ addLegendsAndMarks
+ 	"Add legends and tick-marks."
+ 
+ 	| index offset current n legendCenter markCenter aMark aLegend |
+ 	minValue ifNil: ["too early" ^ self].
+ 
+ 	index := 0.
+ 	offset := self offset.
+ 	(submorphs copyWithout: axis) do: [:m | m delete].
+ 	current := self bottom - offset.
+ 	[current  > (self top + offset)] whileTrue:
+ 		[n := minValue + index.
+ 		(n isDivisibleBy: unitsPerMark) ifTrue:
+ 			[markCenter := self left + self legendsWidth + (self marksWidth // 2) @ current.
+ 			aMark := self newMark.
+ 			self addMorph: aMark.
+ 			aMark center: markCenter; color: self color.
+ 
+ 			(n isDivisibleBy: (self marksPerLegend * self unitsPerMark)) ifTrue:
+ 				[legendCenter := self left + self legendsWidth - ((self widthOfString: n asString)
+ 									// 2) @ current + (-2 @ 0).
+ 				(n = 0 and: [showZero not]) ifFalse:
+ 					[aLegend := StringMorph contents: n asString.
+ 					self addMorph: aLegend.
+ 					aLegend center: legendCenter; color: self color]]].
+ 			current := current - pixelsPerUnit.
+ 			index := index + 1].
+ 	^ index!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>asValidExtent: (in category 'initialization') -----
+ asValidExtent: newExtent 
+ 	^ self marksWidth + self legendsWidth
+ 		@ (newExtent y max: 100)!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>centerOfAxisVertex: (in category 'initialization') -----
+ centerOfAxisVertex: n 
+ 	n = 1
+ 		ifTrue: [^ self left + self legendsWidth @ self bottom].
+ 	n = 2
+ 		ifTrue: [^ self left + self legendsWidth @ self top].
+ 	^ self error: 'Invalid vertex'!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self extent: self allowance @ 600!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>maxValue (in category 'accessing') -----
+ maxValue
+ 	"Answer the maximum value, in graph coordinates, represented by the point at the top of the receiver."
+ 
+ 	^ minValue + (self height - self allowance / pixelsPerUnit) rounded!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>maxValue: (in category 'accessing') -----
+ maxValue: aNumber 
+ 	"Set the max value as indicated; this will typically result in a change in actual bounds of the receiver."
+ 
+ 	| newHeight |
+ 	newHeight := (aNumber - minValue * pixelsPerUnit) rounded + self allowance + (self legendsHeight / 2).
+ 	self bounds: (self bounds withTop: self bounds top - (newHeight - self height))!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>minValue: (in category 'accessing') -----
+ minValue: aNumber
+ 	"Establish the value corresponding to the lowest end of the line."
+ 
+ 	| diff |
+ 	diff := self minValue - aNumber.
+ 	self bounds: (self bounds withBottom: self bounds bottom + (self pixelsPerUnit * diff)).
+ 	super minValue: aNumber!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>newMark (in category 'initialization') -----
+ newMark
+ 	^ Morph new extent: self marksWidth @ 2!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>placeLegendsAndMarks: (in category 'initialization') -----
+ placeLegendsAndMarks: aBlock
+ 	"Place the legends and tick-marks. The block provided has four arguments: :index :n :legendCenter :markCenter"
+ 
+ 	| index offset current n legendCenter markCenter |
+ 	index := 0.
+ 	offset := self offset.
+ 	current := self bottom - offset.
+ 	[current > (self top + offset)]
+ 		whileTrue: [n := minValue + index.
+ 			index := index + 1.
+ 			(index - 1 isDivisibleBy: increment)
+ 				ifTrue: [legendCenter := self left + self legendsWidth - ((self widthOfString: n asString)
+ 									/ 2) @ current + (-2 @ 0).
+ 					markCenter := self left + self legendsWidth + (self marksWidth / 2) @ current.
+ 					aBlock valueWithArguments: {index. n. legendCenter. markCenter}].
+ 			current := current - pixelsPerUnit].
+ 	^ index!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>registerGraphCoordinate:atPlayfieldLocation: (in category 'coordinates') -----
+ registerGraphCoordinate: aGraphCoordinate atPlayfieldLocation: desiredPlayfieldCoordinate
+ 	"Fine-tuning for perfect registry."
+ 
+ 	| itsCurrentOnPlayfield delta |
+ 	itsCurrentOnPlayfield := self bottom - ((aGraphCoordinate - minValue) * pixelsPerUnit) + self offset. "relative to playfield's bottom edge"
+ 	delta := (desiredPlayfieldCoordinate - itsCurrentOnPlayfield) + owner bottom.
+ 	self bottom: self bottom + delta.
+ 	self update!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>setExtentFromHalo: (in category 'accessing') -----
+ setExtentFromHalo: anExtent
+ 	"The user having operated the yellow handle to resize the receiver, adjust the line accordingly."
+ 
+ 	| diff |
+  	diff := (anExtent y - self extent y / self pixelsPerUnit) rounded.
+ 	self minValue: (self minValue - diff)!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>setYOnGraphFor:to: (in category 'coordinates') -----
+ setYOnGraphFor: aMorph to: aNumber
+ 	"Interpreting the second argument as being in 'graph coordinates', as specified by the receiver serving as a y-axis, place the morph such that its yOnGraph is the given quantity."
+ 
+ 	| start |
+ 	start := self bottom - self offset.
+ 	aMorph center: aMorph center x @ (start - (aNumber - minValue * pixelsPerUnit))!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>verticalCoordinateForY: (in category 'coordinates') -----
+ verticalCoordinateForY: aYValue
+ 	"Answer the vertical coordinate in the 'graph coordinate space' of a number interpreted as a vertical pixel coordinate."
+ 
+ 	| start origin |
+ 	start := self bottom - self offset.
+ 	origin := start - (0 - minValue * pixelsPerUnit).
+ 	^ (origin - aYValue) / pixelsPerUnit!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>verticalCoordinateOf: (in category 'coordinates') -----
+ verticalCoordinateOf: anObject
+ 	"Answer the yOnGraph, with respect to the receiver (used as a y-axis), of a morph."
+ 
+ 	^ self verticalCoordinateForY: anObject center y!



More information about the etoys-dev mailing list