[etoys-dev] Etoys Inbox: GSoC-Graphing-Richo.2.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Aug 7 12:31:19 EDT 2010
A new version of GSoC-Graphing was added to project Etoys Inbox:
http://source.squeak.org/etoysinbox/GSoC-Graphing-Richo.2.mcz
==================== Summary ====================
Name: GSoC-Graphing-Richo.2
Author: Richo
Time: 6 July 2010, 12:30:53 pm
UUID: a5e35ccb-9784-4a49-b74a-ffb2a94c17ff
Ancestors: GSoC-Graphing-Richo.1
* Clear required packages (otherwise it won't load in Etoys4)
==================== Snapshot ====================
SystemOrganization addCategory: #'GSoC-Graphing'!
PolygonMorph subclass: #VectorMorph
instanceVariableNames: 'graph vector'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!VectorMorph commentStamp: 'Richo 4/18/2010 00:23' prior: 0!
This object is used by DataGraphMorph to draw vectors. It needs to know the graph in which it is plotted to be able to update its position whenever necessary.!
----- Method: VectorMorph classSide>>additionsToViewerCategories (in category 'viewer categories') -----
additionsToViewerCategories
^ #(
(#plot (
#(command remove '' )
#(slot initialPointX '' Number readWrite Player getInitialPointX Player setInitialPointX: )
#(slot initialPointY '' Number readWrite Player getInitialPointY Player setInitialPointY: )
#(slot terminalPointX '' Number readWrite Player getTerminalPointX Player setTerminalPointX: )
#(slot terminalPointY '' Number readWrite Player getTerminalPointY Player setTerminalPointY: )
#(slot vectorAngle '' Number readWrite Player getVectorAngle Player setVectorAngle: )
#(slot vectorColor '' Color readWrite Player getVectorColor Player setVectorColor: )
#(slot vectorMagnitude '' Number readWrite Player getVectorMagnitude Player setVectorMagnitude: )
))
)!
----- Method: VectorMorph classSide>>graph:vector: (in category 'instance creation') -----
graph: aDataGraphMorph vector: aVector
^(self basicNew setGraph: aDataGraphMorph vector: aVector) initialize!
----- Method: VectorMorph>>color (in category 'accessing') -----
color
^borderColor!
----- Method: VectorMorph>>color: (in category 'accessing') -----
color: aColor
self borderColor: aColor.
super color: aColor.!
----- Method: VectorMorph>>dismissViaHalo (in category 'initialize-release') -----
dismissViaHalo
self remove.
super dismissViaHalo!
----- Method: VectorMorph>>from:to: (in category 'accessing') -----
from: startPoint to: endPoint
"We don't calculate clipped vector, otherwise the arrow may be misplaced when part of the vector extremity is outisde the drawing area'"
vertices at: 1 put: startPoint asIntegerPoint .
vertices at: 2 put: endPoint asIntegerPoint.
self computeBounds
!
----- Method: VectorMorph>>initialize (in category 'initialize-release') -----
initialize
super initialize.
self makeOpen.
vertices := Array with: 0 at 0 with: 0 at 0.
arrows := #forward.
self arrowSpec: 4 at 3; color: Color blue.
self update!
----- Method: VectorMorph>>newPlayerInstance (in category 'initialize-release') -----
newPlayerInstance
^ VectorPlayer newUserInstance!
----- Method: VectorMorph>>position: (in category 'accessing') -----
position: aPoint
super position: aPoint.
self update!
----- Method: VectorMorph>>privateCenter: (in category 'private') -----
privateCenter: aPoint
self privatePosition: (aPoint - (self extent // 2))!
----- Method: VectorMorph>>privatePosition: (in category 'private') -----
privatePosition: aPoint
^super position: aPoint!
----- Method: VectorMorph>>remove (in category 'initialize-release') -----
remove
graph removeVector: vector!
----- Method: VectorMorph>>setGraph:vector: (in category 'private') -----
setGraph: aDataGraphMorph vector: aVector
graph := aDataGraphMorph.
vector := aVector!
----- Method: VectorMorph>>update (in category 'update') -----
update
self penUpWhile: [self vector: vector]!
----- Method: VectorMorph>>vector (in category 'accessing') -----
vector
^vector!
----- Method: VectorMorph>>vector: (in category 'accessing') -----
vector: aVector
self from: (graph cartesianPointToPixel: aVector initialPoint) to: (graph cartesianPointToPixel: aVector terminalPoint).
vector := aVector!
SketchMorph subclass: #PointMorph
instanceVariableNames: 'graph cartesianPosition point'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!PointMorph commentStamp: 'Richo 4/17/2010 21:06' prior: 0!
This object is used by DataGraphMorph to draw points. It needs to know the graph in which it is plotted to be able to update its position whenever necessary.!
----- Method: PointMorph classSide>>additionsToViewerCategories (in category 'viewer categories') -----
additionsToViewerCategories
^ #(
(#plot (
#(command remove '' )
#(slot pointX '' Number readWrite Player getPointX Player setPointX: )
#(slot pointY '' Number readWrite Player getPointY Player setPointY: )
#(slot pointColor '' Color readWrite Player getPointColor Player setPointColor: )
))
)!
----- Method: PointMorph classSide>>defaultNameStemForInstances (in category 'as yet unclassified') -----
defaultNameStemForInstances
^ 'Point' !
----- Method: PointMorph classSide>>graph:point: (in category 'instance creation') -----
graph: aDataGraphMorph point: aPoint
^(self basicNew setGraph: aDataGraphMorph point: aPoint) initialize!
----- Method: PointMorph>>color (in category 'accessing') -----
color
^ color!
----- Method: PointMorph>>color: (in category 'accessing') -----
color: aColor
"Set the receiver's color. Directly set the color if appropriate, else go by way of fillStyle"
(aColor isColor or: [aColor isKindOf: InfiniteForm]) ifFalse:[^ self fillStyle: aColor].
color = aColor ifFalse:
[self removeProperty: #fillStyle.
color _ aColor.
self changed].
self initializeForm!
----- Method: PointMorph>>dismissViaHalo (in category 'initialize-release') -----
dismissViaHalo
self remove.
super dismissViaHalo!
----- Method: PointMorph>>fillStyle: (in category 'accessing') -----
fillStyle: aFillStyle
"Set the current fillStyle of the receiver."
self setProperty: #fillStyle toValue: aFillStyle.
"Workaround for Morphs not yet converted"
self color: aFillStyle asColor!
----- Method: PointMorph>>initialize (in category 'initialize-release') -----
initialize
super initialize.
self color: Color red; initializeForm; update!
----- Method: PointMorph>>initializeForm (in category 'initialize-release') -----
initializeForm
| tempForm |
tempForm := (Form extent: 6 at 6 depth: 32).
tempForm getCanvas fillOval: tempForm boundingBox color: self color.
self form: tempForm!
----- Method: PointMorph>>newPlayerInstance (in category 'initialize-release') -----
newPlayerInstance
^ PointPlayer newUserInstance!
----- Method: PointMorph>>point (in category 'accessing') -----
point
^point!
----- Method: PointMorph>>point: (in category 'accessing') -----
point: aPoint
self privateCenter: (graph cartesianPointToPixel: aPoint).
point := aPoint!
----- Method: PointMorph>>position: (in category 'accessing') -----
position: aPoint
owner isNil ifFalse: [point := (graph relativePixelToCartesianPoint: aPoint + (self extent // 2) - graph topLeft)].
^super position: aPoint!
----- Method: PointMorph>>privateCenter: (in category 'private') -----
privateCenter: aPoint
self privatePosition: (aPoint - (self extent // 2))!
----- Method: PointMorph>>privatePosition: (in category 'private') -----
privatePosition: aPoint
^super position: aPoint!
----- Method: PointMorph>>remove (in category 'initialize-release') -----
remove
graph removePoint: point!
----- Method: PointMorph>>setGraph:point: (in category 'private') -----
setGraph: aDataGraphMorph point: aPoint
graph := aDataGraphMorph.
point := aPoint.!
----- Method: PointMorph>>update (in category 'updating') -----
update
self penUpWhile: [self point: point].
!
Player subclass: #BarPlayer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
----- Method: BarPlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: BarPlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ PointPlayer!
----- Method: BarPlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: BarPlayer>>getBarColor (in category 'slots') -----
getBarColor
^ self costume renderedMorph color!
----- Method: BarPlayer>>getBarLabel (in category 'slots') -----
getBarLabel
^ self costume renderedMorph bar key!
----- Method: BarPlayer>>getBarValue (in category 'slots') -----
getBarValue
^ self costume renderedMorph bar value!
----- Method: BarPlayer>>remove (in category 'commands') -----
remove
^ self costume renderedMorph remove!
----- Method: BarPlayer>>setBarColor: (in category 'slots') -----
setBarColor: aColor
^ self costume renderedMorph color: aColor!
----- Method: BarPlayer>>setBarLabel: (in category 'slots') -----
setBarLabel: aString
| morph |
morph := self costume renderedMorph.
morph bar: aString -> morph bar value.!
----- Method: BarPlayer>>setBarValue: (in category 'slots') -----
setBarValue: aNumber
| morph |
morph := self costume renderedMorph.
morph bar: morph bar key -> aNumber.!
Player subclass: #BarTablePlayer
instanceVariableNames: 'barIndex'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
----- Method: BarTablePlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: BarTablePlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ BarTablePlayer!
----- Method: BarTablePlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: BarTablePlayer>>addBar (in category 'commands') -----
addBar
^ self costume renderedMorph addBar!
----- Method: BarTablePlayer>>apply (in category 'commands') -----
apply
^ self costume renderedMorph apply!
----- Method: BarTablePlayer>>getBarCount (in category 'slots') -----
getBarCount
^( self costume renderedMorph list submorphs select: [:each| each isAlignmentMorph and: [each submorphs first isTextMorph]]) size!
----- Method: BarTablePlayer>>getBarIndex (in category 'slots') -----
getBarIndex
barIndex > self getBarCount ifTrue: [barIndex := self getBarCount].
^ barIndex!
----- Method: BarTablePlayer>>getBarLabel (in category 'slots') -----
getBarLabel
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = barIndex ifTrue: [
^each submorphs first contents asString
]
]
]!
----- Method: BarTablePlayer>>getBarValue (in category 'slots') -----
getBarValue
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = barIndex ifTrue: [
^[each submorphs second contents asString asNumber] on: Error do: [0]
]
]
]!
----- Method: BarTablePlayer>>getBarsFilled (in category 'slots') -----
getBarsFilled
^ self costume renderedMorph bars size!
----- Method: BarTablePlayer>>initialize (in category 'initialize-release') -----
initialize
super initialize.
barIndex := 1.!
----- Method: BarTablePlayer>>removeBar (in category 'commands') -----
removeBar
^ self costume renderedMorph removeBar!
----- Method: BarTablePlayer>>setBarIndex: (in category 'slots') -----
setBarIndex: aNumber
self getBarCount = 0
ifTrue: [barIndex := 0. ^self].
(aNumber > self getBarCount)
ifTrue: [barIndex := 1.^self].
aNumber < 1
ifTrue: [barIndex := self getBarCount.^self].
barIndex := aNumber.!
----- Method: BarTablePlayer>>setBarLabel: (in category 'slots') -----
setBarLabel: aString
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = barIndex ifTrue: [
each submorphs first contents: aString asString.
^self
]
]
]!
----- Method: BarTablePlayer>>setBarValue: (in category 'slots') -----
setBarValue: aNumber
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = barIndex ifTrue: [
each submorphs second contents: aNumber asString.
^self
]
]
]!
Player subclass: #CartesianGraphPlayer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!CartesianGraphPlayer commentStamp: 'Richo 4/17/2010 20:52' prior: 0!
This class is needed to add Etoys scripting capabitlities to DataGraphMorph.!
----- Method: CartesianGraphPlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: CartesianGraphPlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ CartesianGraphPlayer!
----- Method: CartesianGraphPlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: CartesianGraphPlayer>>getAxisColor (in category 'slots') -----
getAxisColor
^ self costume renderedMorph axisColor!
----- Method: CartesianGraphPlayer>>getBackgroundColor (in category 'slots') -----
getBackgroundColor
^ self costume renderedMorph backgroundColor!
----- Method: CartesianGraphPlayer>>getMajorGridColor (in category 'slots') -----
getMajorGridColor
^ self costume renderedMorph majorGridColor!
----- Method: CartesianGraphPlayer>>getMinorGridColor (in category 'slots') -----
getMinorGridColor
^ self costume renderedMorph minorGridColor!
----- Method: CartesianGraphPlayer>>getShowCursorPosition (in category 'slots') -----
getShowCursorPosition
^ self costume renderedMorph showCursorPosition!
----- Method: CartesianGraphPlayer>>getXLegendSpacing (in category 'slots') -----
getXLegendSpacing
^ self costume renderedMorph legendSpacing x!
----- Method: CartesianGraphPlayer>>getXMajorGrid (in category 'slots') -----
getXMajorGrid
^ self costume renderedMorph majorGrid x!
----- Method: CartesianGraphPlayer>>getXMax (in category 'slots') -----
getXMax
^ self costume renderedMorph cartesianBounds right!
----- Method: CartesianGraphPlayer>>getXMin (in category 'slots') -----
getXMin
^ self costume renderedMorph cartesianBounds left!
----- Method: CartesianGraphPlayer>>getXMinorGrid (in category 'slots') -----
getXMinorGrid
^ self costume renderedMorph minorGrid x!
----- Method: CartesianGraphPlayer>>getYLegendSpacing (in category 'slots') -----
getYLegendSpacing
^ self costume renderedMorph legendSpacing y!
----- Method: CartesianGraphPlayer>>getYMajorGrid (in category 'slots') -----
getYMajorGrid
^ self costume renderedMorph majorGrid y!
----- Method: CartesianGraphPlayer>>getYMax (in category 'slots') -----
getYMax
^ self costume renderedMorph cartesianBounds bottom!
----- Method: CartesianGraphPlayer>>getYMin (in category 'slots') -----
getYMin
^self costume renderedMorph cartesianBounds top!
----- Method: CartesianGraphPlayer>>getYMinorGrid (in category 'slots') -----
getYMinorGrid
^ self costume renderedMorph minorGrid y!
----- Method: CartesianGraphPlayer>>move: (in category 'commands') -----
move: aPoint
| p |
aPoint isString
ifTrue: [p := aPoint subStrings: {$@}. p := p first asNumber @ p second asNumber ]
ifFalse: [p := aPoint].
^ self costume renderedMorph move: p!
----- Method: CartesianGraphPlayer>>moveDown: (in category 'commands') -----
moveDown: aNumber
^ self costume renderedMorph move: 0 @ (aNumber negated)!
----- Method: CartesianGraphPlayer>>moveLeft: (in category 'commands') -----
moveLeft: aNumber
^ self costume renderedMorph move: aNumber negated @ 0!
----- Method: CartesianGraphPlayer>>moveRight: (in category 'commands') -----
moveRight: aNumber
^ self costume renderedMorph move: aNumber @ 0!
----- Method: CartesianGraphPlayer>>moveUp: (in category 'commands') -----
moveUp: aNumber
^ self costume renderedMorph move: 0 @ aNumber!
----- Method: CartesianGraphPlayer>>restoreDefaultColors (in category 'commands') -----
restoreDefaultColors
^ self costume renderedMorph restoreDefaultColors.!
----- Method: CartesianGraphPlayer>>restoreDefaultGrids (in category 'commands') -----
restoreDefaultGrids
^ self costume renderedMorph restoreDefaultGrids.!
----- Method: CartesianGraphPlayer>>restoreInitialPosition (in category 'commands') -----
restoreInitialPosition
^ self costume renderedMorph restoreInitialPosition !
----- Method: CartesianGraphPlayer>>setAxisColor: (in category 'slots') -----
setAxisColor: aColor
^ self costume renderedMorph axisColor: aColor!
----- Method: CartesianGraphPlayer>>setBackgroundColor: (in category 'slots') -----
setBackgroundColor: aColor
^ self costume renderedMorph backgroundColor: aColor!
----- Method: CartesianGraphPlayer>>setMajorGridColor: (in category 'slots') -----
setMajorGridColor: aColor
^ self costume renderedMorph majorGridColor: aColor!
----- Method: CartesianGraphPlayer>>setMinorGridColor: (in category 'slots') -----
setMinorGridColor: aColor
^ self costume renderedMorph minorGridColor: aColor!
----- Method: CartesianGraphPlayer>>setShowCursorPosition: (in category 'slots') -----
setShowCursorPosition: aBoolean
^ self costume renderedMorph showCursorPosition: aBoolean!
----- Method: CartesianGraphPlayer>>setXLegendSpacing: (in category 'slots') -----
setXLegendSpacing: anInteger
| morph |
morph := self costume renderedMorph.
morph legendSpacing: ((anInteger max: 0) rounded @ morph legendSpacing y)!
----- Method: CartesianGraphPlayer>>setXMajorGrid: (in category 'slots') -----
setXMajorGrid: aNumber
| morph |
morph := self costume renderedMorph.
morph majorGrid: (aNumber max: 0) rounded @ morph majorGrid y.!
----- Method: CartesianGraphPlayer>>setXMax: (in category 'slots') -----
setXMax: aNumber
| morph |
morph := self costume renderedMorph.
[morph cartesianBounds: (morph cartesianBounds origin corner: (aNumber @ morph cartesianBounds corner y))]
on: Error do: [:err| self inform: err description].!
----- Method: CartesianGraphPlayer>>setXMin: (in category 'slots') -----
setXMin: aNumber
| morph |
morph := self costume renderedMorph.
[morph cartesianBounds: ((aNumber @ morph cartesianBounds origin y) corner: morph cartesianBounds corner)]
on: Error do: [:err| self inform: err description]..!
----- Method: CartesianGraphPlayer>>setXMinorGrid: (in category 'slots') -----
setXMinorGrid: aNumber
| morph |
morph := self costume renderedMorph.
morph minorGrid: (aNumber max: 0) rounded @ morph minorGrid y.!
----- Method: CartesianGraphPlayer>>setYLegendSpacing: (in category 'slots') -----
setYLegendSpacing: anInteger
| morph |
morph := self costume renderedMorph.
morph legendSpacing: (morph legendSpacing x @ (anInteger max: 0) rounded )!
----- Method: CartesianGraphPlayer>>setYMajorGrid: (in category 'slots') -----
setYMajorGrid: aNumber
| morph |
morph := self costume renderedMorph.
morph majorGrid: morph majorGrid x @ ((aNumber max: 0) rounded).!
----- Method: CartesianGraphPlayer>>setYMax: (in category 'slots') -----
setYMax: aNumber
| morph |
morph := self costume renderedMorph.
[morph cartesianBounds: (morph cartesianBounds origin corner: (morph cartesianBounds corner x @ aNumber))]
on: Error do: [:err| self inform: err description]..!
----- Method: CartesianGraphPlayer>>setYMin: (in category 'slots') -----
setYMin: aNumber
| morph |
morph := self costume renderedMorph.
[morph cartesianBounds: ((morph cartesianBounds origin x @ aNumber) corner: morph cartesianBounds corner)]
on: Error do: [:err| self inform: err description]..!
----- Method: CartesianGraphPlayer>>setYMinorGrid: (in category 'slots') -----
setYMinorGrid: aNumber
| morph |
morph := self costume renderedMorph.
morph minorGrid: morph minorGrid x @ ((aNumber max: 0) rounded).!
CartesianGraphPlayer subclass: #DataGraphPlayer
instanceVariableNames: 'pointIndex vectorIndex'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
DataGraphPlayer subclass: #BarGraphPlayer
instanceVariableNames: 'barIndex'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
----- Method: BarGraphPlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: BarGraphPlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ BarGraphPlayer!
----- Method: BarGraphPlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: BarGraphPlayer>>addBar (in category 'commands-bars') -----
addBar
self costume renderedMorph addBar: (($A to: $Z) at: self getBarCount + 1 ifAbsent: [$#]) asString -> 1.
barIndex := self getBarCount!
----- Method: BarGraphPlayer>>currentBar (in category 'accessing') -----
currentBar
^self costume renderedMorph barAt: barIndex ifAbsent: [nil]!
----- Method: BarGraphPlayer>>getBarColor (in category 'slots-bars') -----
getBarColor
^ [self costume renderedMorph barColorAt: barIndex] on: Error do: [Color black]!
----- Method: BarGraphPlayer>>getBarCount (in category 'slots-bars') -----
getBarCount
^ self costume renderedMorph barCount!
----- Method: BarGraphPlayer>>getBarIndex (in category 'slots-bars') -----
getBarIndex
barIndex > self getBarCount ifTrue: [barIndex := self getBarCount].
^ barIndex!
----- Method: BarGraphPlayer>>getBarLabel (in category 'slots-bars') -----
getBarLabel
| current |
current := self currentBar.
^current isNil ifTrue: [nil] ifFalse: [current key]!
----- Method: BarGraphPlayer>>getBarValue (in category 'slots-bars') -----
getBarValue
| current |
current := self currentBar.
^current isNil ifTrue: [nil] ifFalse: [current value]!
----- Method: BarGraphPlayer>>getDistanceBetweenBars (in category 'slots-bars') -----
getDistanceBetweenBars
^ self costume renderedMorph distanceBetweenBars!
----- Method: BarGraphPlayer>>getGraphDirection (in category 'slots-bars') -----
getGraphDirection
^ self costume renderedMorph graphDirection!
----- Method: BarGraphPlayer>>getLegendSpacing (in category 'slots') -----
getLegendSpacing
^ self costume renderedMorph legendSpacing!
----- Method: BarGraphPlayer>>getMajorGrid (in category 'slots') -----
getMajorGrid
^ self costume renderedMorph majorGrid!
----- Method: BarGraphPlayer>>getMax (in category 'slots') -----
getMax
^self costume renderedMorph range last!
----- Method: BarGraphPlayer>>getMin (in category 'slots') -----
getMin
^self costume renderedMorph range first!
----- Method: BarGraphPlayer>>getMinorGrid (in category 'slots') -----
getMinorGrid
^ self costume renderedMorph minorGrid!
----- Method: BarGraphPlayer>>initialize (in category 'initialize-release') -----
initialize
super initialize.
barIndex := 0.
!
----- Method: BarGraphPlayer>>move: (in category 'commands') -----
move: aNumber
^ self costume renderedMorph move: aNumber!
----- Method: BarGraphPlayer>>openBarTable (in category 'commands-bars') -----
openBarTable
self costume renderedMorph openBarTable!
----- Method: BarGraphPlayer>>removeAllBars (in category 'commands-bars') -----
removeAllBars
barIndex := 0.
^ self costume renderedMorph removeAllBars!
----- Method: BarGraphPlayer>>removeBarAt: (in category 'commands-bars') -----
removeBarAt: aNumber
(aNumber > self getBarCount or: [aNumber <= 0])
ifTrue: [^self].
self costume renderedMorph removeBarAt: aNumber.
barIndex = aNumber ifTrue: [self setBarIndex: barIndex - 1]!
----- Method: BarGraphPlayer>>removeCurrentBar (in category 'commands-bars') -----
removeCurrentBar
barIndex = 0 ifTrue: [^self].
self costume renderedMorph removeBarAt: barIndex.
self setBarIndex: barIndex - 1!
----- Method: BarGraphPlayer>>setBarColor: (in category 'slots-bars') -----
setBarColor: aColor
[self costume renderedMorph barColorAt: barIndex put: aColor] on: Error do: []!
----- Method: BarGraphPlayer>>setBarIndex: (in category 'slots-bars') -----
setBarIndex: aNumber
self getBarCount = 0
ifTrue: [barIndex := 0. ^self].
(aNumber > self getBarCount)
ifTrue: [barIndex := 1.^self].
aNumber < 1
ifTrue: [barIndex := self getBarCount.^self].
barIndex := aNumber.!
----- Method: BarGraphPlayer>>setBarLabel: (in category 'slots-bars') -----
setBarLabel: aString
| current |
current := self currentBar.
current isNil ifTrue: [^self].
self costume renderedMorph barAt: barIndex put: (aString -> current value)!
----- Method: BarGraphPlayer>>setBarValue: (in category 'slots-bars') -----
setBarValue: aNumber
| current |
current := self currentBar.
current isNil ifTrue: [^self].
self costume renderedMorph barAt: barIndex put: (current key -> aNumber)!
----- Method: BarGraphPlayer>>setDistanceBetweenBars: (in category 'slots-bars') -----
setDistanceBetweenBars: aNumber
^ self costume renderedMorph distanceBetweenBars: aNumber!
----- Method: BarGraphPlayer>>setGraphDirection: (in category 'slots-bars') -----
setGraphDirection: aSymbol
self costume renderedMorph graphDirection: aSymbol!
----- Method: BarGraphPlayer>>setLegendSpacing: (in category 'slots') -----
setLegendSpacing: aNumber
^ self costume renderedMorph legendSpacing: (aNumber max: 0) rounded!
----- Method: BarGraphPlayer>>setMajorGrid: (in category 'slots') -----
setMajorGrid: aNumber
^ self costume renderedMorph majorGrid: (aNumber max: 0) rounded!
----- Method: BarGraphPlayer>>setMax: (in category 'slots') -----
setMax: aNumber
| morph |
morph := self costume renderedMorph.
morph range: (morph range first to: aNumber)!
----- Method: BarGraphPlayer>>setMin: (in category 'slots') -----
setMin: aNumber
| morph |
morph := self costume renderedMorph.
morph range: (aNumber to: morph range last)!
----- Method: BarGraphPlayer>>setMinorGrid: (in category 'slots') -----
setMinorGrid: aNumber
^ self costume renderedMorph minorGrid: (aNumber max: 0) rounded!
----- Method: DataGraphPlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: DataGraphPlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ DataGraphPlayer!
----- Method: DataGraphPlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: DataGraphPlayer>>addPoint (in category 'commands-points') -----
addPoint
self costume renderedMorph addPoint: (0 at 0).
pointIndex := self getPointCount!
----- Method: DataGraphPlayer>>addVector (in category 'commands-vectors') -----
addVector
self costume renderedMorph addVector: ((0 at 0) to: (0 at 0)).
vectorIndex := self getVectorCount!
----- Method: DataGraphPlayer>>currentPoint (in category 'accessing') -----
currentPoint
^self costume renderedMorph pointAt: pointIndex ifAbsent: [nil]!
----- Method: DataGraphPlayer>>currentVector (in category 'accessing') -----
currentVector
^self costume renderedMorph vectorAt: vectorIndex ifAbsent: [nil]!
----- Method: DataGraphPlayer>>getInitialPointX (in category 'slots-vectors') -----
getInitialPointX
| current |
current := self currentVector.
^current isNil ifTrue: [nil] ifFalse: [current initialPoint x]!
----- Method: DataGraphPlayer>>getInitialPointY (in category 'slots-vectors') -----
getInitialPointY
| current |
current := self currentVector.
^current isNil ifTrue: [nil] ifFalse: [current initialPoint y]!
----- Method: DataGraphPlayer>>getPlayerAtPointIndex (in category 'slots-points') -----
getPlayerAtPointIndex
| morph |
morph := self costume renderedMorph pointMorphAt: pointIndex.
morph isNil ifTrue: [^ self presenter standardPlayer].
^morph assuredPlayer!
----- Method: DataGraphPlayer>>getPlayerAtVectorIndex (in category 'slots-vectors') -----
getPlayerAtVectorIndex
| morph |
morph := self costume renderedMorph vectorMorphAt: vectorIndex.
morph isNil ifTrue: [^ self presenter standardPlayer].
^morph assuredPlayer!
----- Method: DataGraphPlayer>>getPointColor (in category 'slots-points') -----
getPointColor
^ [self costume renderedMorph pointColorAt: pointIndex] on: Error do: [Color black]!
----- Method: DataGraphPlayer>>getPointCount (in category 'slots-points') -----
getPointCount
^ self costume renderedMorph pointCount!
----- Method: DataGraphPlayer>>getPointIndex (in category 'slots-points') -----
getPointIndex
pointIndex > self getPointCount ifTrue: [pointIndex := self getPointCount].
^ pointIndex!
----- Method: DataGraphPlayer>>getPointX (in category 'slots-points') -----
getPointX
| current |
current := self currentPoint.
^current isNil ifTrue: [nil] ifFalse: [current x]!
----- Method: DataGraphPlayer>>getPointY (in category 'slots-points') -----
getPointY
| current |
current := self currentPoint.
^current isNil ifTrue: [nil] ifFalse: [current y]!
----- Method: DataGraphPlayer>>getTerminalPointX (in category 'slots-vectors') -----
getTerminalPointX
| current |
current := self currentVector.
^current isNil ifTrue: [nil] ifFalse: [current terminalPoint x]!
----- Method: DataGraphPlayer>>getTerminalPointY (in category 'slots-vectors') -----
getTerminalPointY
| current |
current := self currentVector.
^current isNil ifTrue: [nil] ifFalse: [current terminalPoint y]!
----- Method: DataGraphPlayer>>getVectorAngle (in category 'slots-vectors') -----
getVectorAngle
| current |
current := self currentVector.
^current isNil ifTrue: [nil] ifFalse: [current angle]!
----- Method: DataGraphPlayer>>getVectorColor (in category 'slots-vectors') -----
getVectorColor
^ [self costume renderedMorph vectorColorAt: vectorIndex] on: Error do: [Color black]!
----- Method: DataGraphPlayer>>getVectorCount (in category 'slots-vectors') -----
getVectorCount
^self costume renderedMorph vectorCount!
----- Method: DataGraphPlayer>>getVectorIndex (in category 'slots-vectors') -----
getVectorIndex
vectorIndex > self getVectorCount ifTrue: [vectorIndex := self getVectorCount].
^ vectorIndex!
----- Method: DataGraphPlayer>>getVectorMagnitude (in category 'slots-vectors') -----
getVectorMagnitude
| current |
current := self currentVector.
^current isNil ifTrue: [nil] ifFalse: [current magnitude]!
----- Method: DataGraphPlayer>>initialize (in category 'initialize') -----
initialize
super initialize.
pointIndex := vectorIndex := 0.
!
----- Method: DataGraphPlayer>>openPointTable (in category 'commands-points') -----
openPointTable
^ self costume renderedMorph openPointTable!
----- Method: DataGraphPlayer>>removeAllPoints (in category 'commands-points') -----
removeAllPoints
pointIndex := 0.
^ self costume renderedMorph removeAllPoints!
----- Method: DataGraphPlayer>>removeAllVectors (in category 'commands-vectors') -----
removeAllVectors.
vectorIndex := 0.
^ self costume renderedMorph removeAllVectors!
----- Method: DataGraphPlayer>>removeCurrentPoint (in category 'commands-points') -----
removeCurrentPoint
pointIndex = 0 ifTrue: [^self].
self costume renderedMorph removePointAt: pointIndex.
self setPointIndex: pointIndex - 1!
----- Method: DataGraphPlayer>>removeCurrentVector (in category 'commands-vectors') -----
removeCurrentVector
vectorIndex = 0 ifTrue: [^self].
self costume renderedMorph removeVectorAt: vectorIndex.
self setVectorIndex: vectorIndex - 1!
----- Method: DataGraphPlayer>>removePointAt: (in category 'commands-points') -----
removePointAt: aNumber
(aNumber > self getPointCount or: [aNumber <= 0])
ifTrue: [^self].
self costume renderedMorph removePointAt: aNumber.
pointIndex = aNumber ifTrue: [self setPointIndex: pointIndex - 1]!
----- Method: DataGraphPlayer>>removeVectorAt: (in category 'commands-vectors') -----
removeVectorAt: aNumber
(aNumber > self getVectorCount or: [aNumber <= 0])
ifTrue: [^self].
self costume renderedMorph removeVectorAt: aNumber.
vectorIndex = aNumber ifTrue: [self setVectorIndex: vectorIndex - 1]!
----- Method: DataGraphPlayer>>setInitialPointX: (in category 'slots-vectors') -----
setInitialPointX: aNumber
| current |
current := self currentVector.
current isNil ifTrue: [^self].
self costume renderedMorph vectorAt: vectorIndex put: (Vector initialPoint: (aNumber @ current initialPoint y) angle: current angle magnitude: current magnitude)
!
----- Method: DataGraphPlayer>>setInitialPointY: (in category 'slots-vectors') -----
setInitialPointY: aNumber
| current |
current := self currentVector.
current isNil ifTrue: [^self].
self costume renderedMorph vectorAt: vectorIndex put: (Vector initialPoint: (current initialPoint x @ aNumber) angle: current angle magnitude: current magnitude)
!
----- Method: DataGraphPlayer>>setPointColor: (in category 'slots-points') -----
setPointColor: aColor
[self costume renderedMorph pointColorAt: pointIndex put: aColor] on: Error do: []!
----- Method: DataGraphPlayer>>setPointIndex: (in category 'slots-points') -----
setPointIndex: aNumber
self getPointCount = 0
ifTrue: [pointIndex := 0. ^self].
(aNumber > self getPointCount)
ifTrue: [pointIndex := 1.^self].
aNumber < 1
ifTrue: [pointIndex := self getPointCount.^self].
pointIndex := aNumber.!
----- Method: DataGraphPlayer>>setPointX: (in category 'slots-points') -----
setPointX: aNumber
| current |
current := self currentPoint.
current isNil ifTrue: [^self].
self costume renderedMorph pointAt: pointIndex put: aNumber @ current y!
----- Method: DataGraphPlayer>>setPointY: (in category 'slots-points') -----
setPointY: aNumber
| current |
current := self currentPoint.
current isNil ifTrue: [^self].
self costume renderedMorph pointAt: pointIndex put: current x @ aNumber!
----- Method: DataGraphPlayer>>setTerminalPointX: (in category 'slots-vectors') -----
setTerminalPointX: aNumber
| current |
current := self currentVector.
current isNil ifTrue: [^self].
self costume renderedMorph vectorAt: vectorIndex put: (current initialPoint to: (aNumber @ current terminalPoint y))!
----- Method: DataGraphPlayer>>setTerminalPointY: (in category 'slots-vectors') -----
setTerminalPointY: aNumber
| current |
current := self currentVector.
current isNil ifTrue: [^self].
self costume renderedMorph vectorAt: vectorIndex put: (current initialPoint to: (current terminalPoint x @ aNumber))!
----- Method: DataGraphPlayer>>setVectorAngle: (in category 'slots-vectors') -----
setVectorAngle: aNumber
| current |
current := self currentVector.
current isNil ifTrue: [^self].
self costume renderedMorph vectorAt: vectorIndex put: (Vector initialPoint: current initialPoint angle: aNumber magnitude: current magnitude)!
----- Method: DataGraphPlayer>>setVectorColor: (in category 'slots-vectors') -----
setVectorColor: aColor
[self costume renderedMorph vectorColorAt: vectorIndex put: aColor] on: Error do: []!
----- Method: DataGraphPlayer>>setVectorIndex: (in category 'slots-vectors') -----
setVectorIndex: aNumber
self getVectorCount = 0
ifTrue: [vectorIndex := 0. ^self].
(aNumber > self getVectorCount)
ifTrue: [vectorIndex := 1.^self].
aNumber < 1
ifTrue: [vectorIndex := self getVectorCount.^self].
vectorIndex := aNumber.!
----- Method: DataGraphPlayer>>setVectorMagnitude: (in category 'slots-vectors') -----
setVectorMagnitude: aNumber
| current |
current := self currentVector.
current isNil ifTrue: [^self].
self costume renderedMorph vectorAt: vectorIndex put: (Vector initialPoint: current initialPoint angle: current angle magnitude: aNumber)!
Player subclass: #PointPlayer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!PointPlayer commentStamp: 'Richo 4/17/2010 21:07' prior: 0!
This class is needed to add Etoys scripting capabitlities to PointMorph. It's actually very useless.!
----- Method: PointPlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: PointPlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ PointPlayer!
----- Method: PointPlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: PointPlayer>>getPointColor (in category 'slots') -----
getPointColor
^ self costume renderedMorph color!
----- Method: PointPlayer>>getPointX (in category 'slots') -----
getPointX
^ self costume renderedMorph point x!
----- Method: PointPlayer>>getPointY (in category 'slots') -----
getPointY
^ self costume renderedMorph point y!
----- Method: PointPlayer>>remove (in category 'commands') -----
remove
^ self costume renderedMorph remove!
----- Method: PointPlayer>>setPointColor: (in category 'slots') -----
setPointColor: aColor
^ self costume renderedMorph color: aColor!
----- Method: PointPlayer>>setPointX: (in category 'slots') -----
setPointX: aNumber
| morph |
morph := self costume renderedMorph.
morph point: aNumber @ morph point y.!
----- Method: PointPlayer>>setPointY: (in category 'slots') -----
setPointY: aNumber
| morph |
morph := self costume renderedMorph.
morph point: morph point x @ aNumber!
Player subclass: #PointTablePlayer
instanceVariableNames: 'pointIndex'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!PointTablePlayer commentStamp: 'Richo 4/17/2010 23:34' prior: 0!
This class is needed to add Etoys scripting capabitlities to PointTableMorph. It lets the user go through the list of points, see how many rows are filled, how many are empty, and so on.!
----- Method: PointTablePlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: PointTablePlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ PointTablePlayer!
----- Method: PointTablePlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: PointTablePlayer>>addPoint (in category 'commands') -----
addPoint
^ self costume renderedMorph addPoint!
----- Method: PointTablePlayer>>apply (in category 'commands') -----
apply
^ self costume renderedMorph apply!
----- Method: PointTablePlayer>>getPointCount (in category 'slots') -----
getPointCount
^( self costume renderedMorph list submorphs select: [:each| each isAlignmentMorph and: [each submorphs first isTextMorph]]) size!
----- Method: PointTablePlayer>>getPointIndex (in category 'slots') -----
getPointIndex
pointIndex > self getPointCount ifTrue: [pointIndex := self getPointCount].
^ pointIndex!
----- Method: PointTablePlayer>>getPointX (in category 'slots') -----
getPointX
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = pointIndex ifTrue: [
^[each submorphs first contents asString asNumber] on: Error do: [0].
]
]
]
!
----- Method: PointTablePlayer>>getPointY (in category 'slots') -----
getPointY
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = pointIndex ifTrue: [
^[each submorphs second contents asString asNumber] on: Error do: [0].
]
]
]!
----- Method: PointTablePlayer>>getPointsFilled (in category 'slots') -----
getPointsFilled
^ self costume renderedMorph points size!
----- Method: PointTablePlayer>>initialize (in category 'initialize-release') -----
initialize
super initialize.
pointIndex := 1.!
----- Method: PointTablePlayer>>removePoint (in category 'commands') -----
removePoint
^ self costume renderedMorph removePoint!
----- Method: PointTablePlayer>>setPointIndex: (in category 'slots') -----
setPointIndex: aNumber
self getPointCount = 0
ifTrue: [pointIndex := 0. ^self].
(aNumber > self getPointCount)
ifTrue: [pointIndex := 1.^self].
aNumber < 1
ifTrue: [pointIndex := self getPointCount.^self].
pointIndex := aNumber.!
----- Method: PointTablePlayer>>setPointX: (in category 'slots') -----
setPointX: aNumber
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = pointIndex ifTrue: [
each submorphs first contents: aNumber asString.
^self
]
]
]!
----- Method: PointTablePlayer>>setPointY: (in category 'slots') -----
setPointY: aNumber
| morph count |
morph := self costume renderedMorph.
count := 0.
morph list submorphs do: [:each|
(each isAlignmentMorph and: [ each submorphs first isTextMorph])
ifTrue: [
count := count + 1.
count = pointIndex ifTrue: [
each submorphs second contents: aNumber asString.
^self
]
]
]!
Player subclass: #VectorPlayer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!VectorPlayer commentStamp: 'Richo 4/18/2010 00:26' prior: 0!
This class is needed to add Etoys scripting capabitlities to VectorMorph. It allows the user to change any of the vector's parameters.!
----- Method: VectorPlayer classSide>>isUniClass (in category 'change set logging') -----
isUniClass
^ self ~~ self officialClass!
----- Method: VectorPlayer classSide>>officialClass (in category 'change set logging') -----
officialClass
^ VectorPlayer!
----- Method: VectorPlayer classSide>>wantsChangeSetLogging (in category 'change set logging') -----
wantsChangeSetLogging
^ (self == self officialClass
or: [(self name beginsWith: self officialClass asString) not])
or: [Preferences universalTiles]!
----- Method: VectorPlayer>>getInitialPointX (in category 'slots') -----
getInitialPointX
^ self costume renderedMorph vector initialPoint x!
----- Method: VectorPlayer>>getInitialPointY (in category 'slots') -----
getInitialPointY
^ self costume renderedMorph vector initialPoint y!
----- Method: VectorPlayer>>getTerminalPointX (in category 'slots') -----
getTerminalPointX
^ self costume renderedMorph vector terminalPoint x!
----- Method: VectorPlayer>>getTerminalPointY (in category 'slots') -----
getTerminalPointY
^ self costume renderedMorph vector terminalPoint y!
----- Method: VectorPlayer>>getVectorAngle (in category 'slots') -----
getVectorAngle
^ self costume renderedMorph vector angle!
----- Method: VectorPlayer>>getVectorColor (in category 'slots') -----
getVectorColor
^ self costume renderedMorph color!
----- Method: VectorPlayer>>getVectorMagnitude (in category 'slots') -----
getVectorMagnitude
^ self costume renderedMorph vector magnitude!
----- Method: VectorPlayer>>remove (in category 'commands') -----
remove
^ self costume renderedMorph remove!
----- Method: VectorPlayer>>setInitialPointX: (in category 'slots') -----
setInitialPointX: aNumber
| morph vector |
morph := self costume renderedMorph.
vector := morph vector.
morph vector: (Vector initialPoint: (aNumber @ vector initialPoint y) angle: vector angle magnitude: vector magnitude)
!
----- Method: VectorPlayer>>setInitialPointY: (in category 'slots') -----
setInitialPointY: aNumber
| morph vector |
morph := self costume renderedMorph.
vector := morph vector.
morph vector: (Vector initialPoint: (vector initialPoint x @ aNumber) angle: vector angle magnitude: vector magnitude)
!
----- Method: VectorPlayer>>setTerminalPointX: (in category 'slots') -----
setTerminalPointX: aNumber
| morph vector |
morph := self costume renderedMorph.
vector := morph vector.
morph vector: (vector initialPoint to: (aNumber @ vector terminalPoint y))!
----- Method: VectorPlayer>>setTerminalPointY: (in category 'slots') -----
setTerminalPointY: aNumber
| morph vector |
morph := self costume renderedMorph.
vector := morph vector.
morph vector: (vector initialPoint to: (vector terminalPoint x @ aNumber))!
----- Method: VectorPlayer>>setVectorAngle: (in category 'slots') -----
setVectorAngle: aNumber
| morph vector |
morph := self costume renderedMorph.
vector := morph vector.
morph vector: (Vector initialPoint: vector initialPoint angle: aNumber magnitude: vector magnitude)!
----- Method: VectorPlayer>>setVectorColor: (in category 'slots') -----
setVectorColor: aColor
^ self costume renderedMorph color: aColor!
----- Method: VectorPlayer>>setVectorMagnitude: (in category 'slots') -----
setVectorMagnitude: aNumber
| morph vector |
morph := self costume renderedMorph.
vector := morph vector.
morph vector: (Vector initialPoint: vector initialPoint angle: vector angle magnitude: aNumber)!
AlignmentMorph subclass: #BarTableMorph
instanceVariableNames: 'numberOfPoints graph list scrollPane numberOfBars'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
----- Method: BarTableMorph classSide>>additionsToViewerCategories (in category 'viewer categories') -----
additionsToViewerCategories
^ #(
(#plot (
#(command apply '' )
#(command addBar '' )
#(command removeBar '' )
#(slot barCount '' Number readOnly Player getBarCount Player unused )
#(slot barIndex '' Number readWrite Player getBarIndex Player setBarIndex: )
#(slot barValue '' Number readWrite Player getBarValue Player setBarValue: )
#(slot barLabel '' String readWrite Player getBarLabel Player setBarLabel: )
#(slot barsFilled '' Number readOnly Player getBarsFilled Player unused )
))
)!
----- Method: BarTableMorph classSide>>includeInNewMorphMenu (in category 'as yet unclassified') -----
includeInNewMorphMenu
"Return true for all classes that can be instantiated from the menu"
^ false!
----- Method: BarTableMorph classSide>>on: (in category 'instance creation') -----
on: aDataGraphMorph
^(self basicNew setGraph: aDataGraphMorph) initialize !
----- Method: BarTableMorph>>addBar (in category 'actions') -----
addBar
| |
numberOfBars := numberOfBars + 1.
list addMorph: (self makeRow: nil) asElementNumber: numberOfBars + 1.
self updateScrollPane.!
----- Method: BarTableMorph>>apply (in category 'actions') -----
apply
| newBars oldBar newBar |
newBars := self bars.
1 to: newBars size do: [:i|
oldBar := graph barAt: i ifAbsent: [nil].
newBar := newBars at: i.
oldBar isNil
ifTrue: [graph addBar: newBar]
ifFalse: [graph barAt: i put: newBar]
].
newBars size < graph barCount
ifTrue: [graph removeBarsFrom: newBars size + 1 to: graph barCount].!
----- Method: BarTableMorph>>bars (in category 'accessing') -----
bars
"Searches across the submorphs and returns an array of points with the data written by the user"
| data firstSubmorph secondSubmorph label value |
data := OrderedCollection new.
list
submorphsDo: [:morph | morph isAlignmentMorph
ifTrue: [
label := value := nil.
firstSubmorph := morph submorphs first.
secondSubmorph := morph submorphs second.
firstSubmorph isTextMorph
ifTrue: [firstSubmorph contents asString = ''
ifFalse: [label := firstSubmorph contents asString]].
secondSubmorph isTextMorph
ifTrue: [secondSubmorph contents asString = ''
ifFalse: [value := self valueFromString: secondSubmorph contents asString]].
(label notNil
and: [value isNumber])
ifTrue: [data add: label -> value]]].
^ data!
----- Method: BarTableMorph>>initialize (in category 'initialize') -----
initialize
| data |
super initialize.
self borderWidth: 0;
color: ((Color
r: 0.817
g: 0.864
b: 0.797)
mixed: 0.75
with: Color blue muchDarker);
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
listDirection: #topToBottom;
cornerStyle: #rounded.
data := graph bars.
numberOfBars := data size max: 10.
self initializeSubmorphsWithData: data!
----- Method: BarTableMorph>>initializeSubmorphsWithData: (in category 'building') -----
initializeSubmorphsWithData: data
"data should be a collection of points."
self addMorphBack: self makeColumnNames;
addMorphBack: (self makeListWithData: data);
addMorphBack: ((SimpleButtonMorph newWithLabel: '-') color: (Color
r: 0.4
g: 0.8
b: 0.6) lighter;
borderWidth: 2;
width: 129;
target: self;
actionSelector: #removeBar);
addMorphBack: (Morph new color: Color transparent;
extent: 10 @ 3);
addMorphBack: ((SimpleButtonMorph newWithLabel: '+') color: (Color
r: 0.4
g: 0.8
b: 0.6) lighter;
borderWidth: 2;
width: 129;
target: self;
actionSelector: #addBar);
addMorphBack: (Morph new color: Color transparent;
extent: 10 @ 3);
addMorphBack: ((SimpleButtonMorph newWithLabel: 'Apply') width: 129;
target: self;
actionSelector: #apply)!
----- Method: BarTableMorph>>list (in category 'accessing') -----
list
^list!
----- Method: BarTableMorph>>makeColumnNames (in category 'building') -----
makeColumnNames
| columnName |
columnName := [:contents | self newTextMorph contents: contents; wrapFlag: true; autoFit: true; backgroundColor: Color transparent; borderWidth: 0; centered].
^ AlignmentMorph newRow color: Color transparent;
addMorphBack: self makeSpacer;
addMorphBack: (columnName value: 'Label');
addMorphBack: self makeSpacer;
addMorphBack: (columnName value: 'Value');
addMorphBack: self makeSpacer;
addMorphBack: (Morph new color: Color transparent; extent: 20 at 1)!
----- Method: BarTableMorph>>makeListWithData: (in category 'building') -----
makeListWithData: data
list := AlignmentMorph newColumn color: Color transparent.
1 to: numberOfBars do: [:i|
list addMorphBack: (self makeRow: (data at: i ifAbsent: [nil]))].
scrollPane := ScrollPane new extent: (self textMorphWidth * 2 ) + 40 at 281; borderWidth: 0.
scrollPane scroller addMorph: list.
data isEmpty ifFalse: [scrollPane vSetScrollDelta].
^scrollPane!
----- Method: BarTableMorph>>makeRow: (in category 'building') -----
makeRow: anAssoc
^ AlignmentMorph newRow color: Color transparent;
addMorphBack: (self newTextMorph
contents: (anAssoc isNil
ifTrue: ['']
ifFalse: [anAssoc key asString]);
wrapFlag: true);
addMorphBack: (self newTextMorph
contents: (anAssoc isNil
ifTrue: ['']
ifFalse: [anAssoc value isInteger ifFalse: [anAssoc value printShowingDecimalPlaces: 2] ifTrue: [anAssoc value asString]]);
wrapFlag: true) !
----- Method: BarTableMorph>>makeSpacer (in category 'building') -----
makeSpacer
^ AlignmentMorph newVariableTransparentSpacer!
----- Method: BarTableMorph>>newPlayerInstance (in category 'initialize') -----
newPlayerInstance
^ BarTablePlayer newUserInstance!
----- Method: BarTableMorph>>newTextMorph (in category 'building') -----
newTextMorph
^ GSoCTextMorph new autoFit: false;
extent: self textMorphWidth @ 23;
borderWidth: 1;
backgroundColor: Color white;
yourself!
----- Method: BarTableMorph>>removeBar (in category 'actions') -----
removeBar
| |
numberOfBars <= 1 ifTrue: [^self].
numberOfBars := numberOfBars - 1.
list removeMorph: list submorphs last.
self updateScrollPane!
----- Method: BarTableMorph>>setGraph: (in category 'private') -----
setGraph: aDataGraphMorph
graph := aDataGraphMorph!
----- Method: BarTableMorph>>textMorphWidth (in category 'private') -----
textMorphWidth
^ 100!
----- Method: BarTableMorph>>updateScrollPane (in category 'actions') -----
updateScrollPane
scrollPane "hHideScrollBar;" vScrollBarValue: 1; vSetScrollDelta!
----- Method: BarTableMorph>>valueFromString: (in category 'accessing') -----
valueFromString: aString
^[Compiler evaluate: aString notifying: SyntaxErrorOmission new logged: false] on: Error do: [nil]!
AlignmentMorph subclass: #PointTableMorph
instanceVariableNames: 'numberOfPoints graph list scrollPane'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!PointTableMorph commentStamp: 'Richo 4/17/2010 23:33' prior: 0!
This object is a table of points whose purpose is let the user fill the DataGraphMorph with points. !
----- Method: PointTableMorph classSide>>additionsToViewerCategories (in category 'viewer categories') -----
additionsToViewerCategories
^ #(
(#plot (
#(command apply '' )
#(command addPoint '' )
#(command removePoint '' )
#(slot pointCount '' Number readOnly Player getPointCount Player unused )
#(slot pointIndex '' Number readWrite Player getPointIndex Player setPointIndex: )
#(slot pointX '' Number readWrite Player getPointX Player setPointX: )
#(slot pointY '' Number readWrite Player getPointY Player setPointY: )
#(slot pointsFilled '' Number readOnly Player getPointsFilled Player unused )
))
)!
----- Method: PointTableMorph classSide>>includeInNewMorphMenu (in category 'as yet unclassified') -----
includeInNewMorphMenu
"Return true for all classes that can be instantiated from the menu"
^ false!
----- Method: PointTableMorph classSide>>on: (in category 'instance creation') -----
on: aDataGraphMorph
^(self basicNew setGraph: aDataGraphMorph) initialize !
----- Method: PointTableMorph>>addPoint (in category 'actions') -----
addPoint
| |
numberOfPoints := numberOfPoints + 1.
" self resetData."
list addMorph: (self makeRow: nil) asElementNumber: numberOfPoints + 1.
self updateScrollPane.!
----- Method: PointTableMorph>>apply (in category 'actions') -----
apply
| newPoints oldPoint newPoint |
newPoints := self points.
1 to: newPoints size do: [:i|
oldPoint := graph pointAt: i ifAbsent: [nil].
newPoint := newPoints at: i.
oldPoint isNil
ifTrue: [graph addPoint: newPoint]
ifFalse: [graph pointAt: i put: newPoint]
].
newPoints size < graph pointCount
ifTrue: [graph removePointsFrom: newPoints size + 1 to: graph pointCount].!
----- Method: PointTableMorph>>initialize (in category 'initialize') -----
initialize
| data |
super initialize.
self borderWidth: 0;
color: ((Color
r: 0.817
g: 0.864
b: 0.797)
mixed: 0.75
with: Color blue muchDarker);
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
listDirection: #topToBottom;
cornerStyle: #rounded.
data := graph points.
numberOfPoints := data size max: 10.
self initializeSubmorphsWithData: data!
----- Method: PointTableMorph>>initializeSubmorphsWithData: (in category 'building') -----
initializeSubmorphsWithData: data
"data should be a collection of points."
self addMorphBack: self makeColumnNames;
addMorphBack: (self makeListWithData: data);
addMorphBack: ((SimpleButtonMorph newWithLabel: '-') color: (Color
r: 0.4
g: 0.8
b: 0.6) lighter;
borderWidth: 2;
width: (self textMorphWidth * 2) + 29;
target: self;
actionSelector: #removePoint);
addMorphBack: (Morph new color: Color transparent;
extent: 10 @ 3);
addMorphBack: ((SimpleButtonMorph newWithLabel: '+') color: (Color
r: 0.4
g: 0.8
b: 0.6) lighter;
borderWidth: 2;
width: (self textMorphWidth * 2) + 29;
target: self;
actionSelector: #addPoint);
addMorphBack: (Morph new color: Color transparent;
extent: 10 @ 3);
addMorphBack: ((SimpleButtonMorph newWithLabel: 'Apply') width: (self textMorphWidth * 2) + 29;
target: self;
actionSelector: #apply)!
----- Method: PointTableMorph>>list (in category 'accessing') -----
list
^list!
----- Method: PointTableMorph>>makeColumnNames (in category 'building') -----
makeColumnNames
| columnName |
columnName := [:contents | self newTextMorph contents: contents; wrapFlag: true; autoFit: true; backgroundColor: Color transparent; borderWidth: 0; centered].
^ AlignmentMorph newRow color: Color transparent;
addMorphBack: self makeSpacer;
addMorphBack: (columnName value: 'x');
addMorphBack: self makeSpacer;
addMorphBack: (columnName value: 'y');
addMorphBack: self makeSpacer;
addMorphBack: (Morph new color: Color transparent; extent: 20 at 1)!
----- Method: PointTableMorph>>makeListWithData: (in category 'building') -----
makeListWithData: data
list := AlignmentMorph newColumn color: Color transparent.
1 to: numberOfPoints do: [:i|
list addMorphBack: (self makeRow: (data at: i ifAbsent: [nil]))].
scrollPane := ScrollPane new extent: (self textMorphWidth * 2) + 40 @281; borderWidth: 0.
scrollPane scroller addMorph: list.
data isEmpty ifFalse: [scrollPane vSetScrollDelta].
^scrollPane!
----- Method: PointTableMorph>>makeRow: (in category 'building') -----
makeRow: aPoint
^ AlignmentMorph newRow color: Color transparent;
addMorphBack: (self newTextMorph
contents: (aPoint isNil
ifTrue: ['']
ifFalse: [aPoint x isInteger ifFalse: [aPoint x printShowingDecimalPlaces: 2] ifTrue: [aPoint x asString]]);
wrapFlag: true);
addMorphBack: (self newTextMorph
contents: (aPoint isNil
ifTrue: ['']
ifFalse: [aPoint y isInteger ifFalse: [aPoint y printShowingDecimalPlaces: 2] ifTrue: [aPoint y asString]]);
wrapFlag: true) !
----- Method: PointTableMorph>>makeSpacer (in category 'building') -----
makeSpacer
^ AlignmentMorph newVariableTransparentSpacer!
----- Method: PointTableMorph>>newPlayerInstance (in category 'initialize') -----
newPlayerInstance
^ PointTablePlayer newUserInstance!
----- Method: PointTableMorph>>newTextMorph (in category 'building') -----
newTextMorph
^GSoCTextMorph new autoFit: false;
extent: self textMorphWidth @ 23;
borderWidth: 1;
backgroundColor: Color white;
yourself!
----- Method: PointTableMorph>>points (in category 'accessing') -----
points
"Searches across the submorphs and returns an array of points with the data written by the user"
| data x y firstSubmorph secondSubmorph |
data := OrderedCollection new.
list
submorphsDo: [:morph | morph isAlignmentMorph
ifTrue: [
x := y := nil.
firstSubmorph := morph submorphs first.
secondSubmorph := morph submorphs second.
firstSubmorph isTextMorph
ifTrue: [firstSubmorph contents asString = ''
ifFalse: [x := self valueFromString: firstSubmorph contents asString]].
secondSubmorph isTextMorph
ifTrue: [secondSubmorph contents asString = ''
ifFalse: [y := self valueFromString: secondSubmorph contents asString]].
(x isNumber
and: [y isNumber])
ifTrue: [data add: x @ y]]].
^ data!
----- Method: PointTableMorph>>removePoint (in category 'actions') -----
removePoint
| |
numberOfPoints <= 1 ifTrue: [^self].
numberOfPoints := numberOfPoints - 1.
list removeMorph: list submorphs last.
self updateScrollPane!
----- Method: PointTableMorph>>setGraph: (in category 'private') -----
setGraph: aDataGraphMorph
graph := aDataGraphMorph!
----- Method: PointTableMorph>>textMorphWidth (in category 'private') -----
textMorphWidth
^75!
----- Method: PointTableMorph>>updateScrollPane (in category 'actions') -----
updateScrollPane
scrollPane vScrollBarValue: 1; vSetScrollDelta!
----- Method: PointTableMorph>>valueFromString: (in category 'accessing') -----
valueFromString: aString
^[Compiler evaluate: aString notifying: SyntaxErrorOmission new logged: false] on: Error do: [nil]!
PasteUpMorph subclass: #CartesianGraphMorph
instanceVariableNames: 'cartesianBounds minorGrid majorGrid legendSpacing backgroundColor minorGridColor majorGridColor axisColor verticalAxis horizontalAxis legends grids gridForm'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!CartesianGraphMorph commentStamp: 'Richo 5/21/2010 08:59' prior: 0!
This class is responsible of drawing a cartesian coordinate system.
You can change its grid, x and y range, legend spacing and colors using the following methods:
#majorGrid:
#minorGrid:
#cartesianBounds:
#legendSpacing:
#axisColor:
#backgroundColor:
#majorGridColor:
#minorGridColor:!
CartesianGraphMorph subclass: #BarGraphMorph
instanceVariableNames: 'barMorphs distanceBetweenBars graphType graphDirection'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
----- Method: BarGraphMorph classSide>>additionsToViewerCategoryPlotBars (in category 'viewer categories') -----
additionsToViewerCategoryPlotBars
^#(#'plot - bars' (
#(slot graphDirection '' GraphDirection readWrite Player getGraphDirection Player setGraphDirection: )
#(slot barIndex '' Number readWrite Player getBarIndex Player setBarIndex: )
#(command removeBarAt: '' Number )
#(command removeAllBars '')
#(command removeCurrentBar '')
#(command addBar '')
#(slot barValue '' Number readWrite Player getBarValue Player setBarValue: )
#(slot barLabel '' String readWrite Player getBarLabel Player setBarLabel: )
#(command openBarTable '')
#(slot barCount '' Number readOnly Player getBarCount Player unused )
#(slot barColor '' Color readWrite Player getBarColor Player setBarColor: )
#(slot distanceBetweenBars '' Number readWrite Player getDistanceBetweenBars Player setDistanceBetweenBars: )
))!
----- Method: BarGraphMorph classSide>>additionsToViewerCategoryPlotGrid (in category 'viewer categories') -----
additionsToViewerCategoryPlotGrid
"This is just to override the #'plot - grid' category (notice the space after grid)"
^#(#'plot - grid ' (
#(slot majorGrid '' Number readWrite Player getMajorGrid Player setMajorGrid: )
#(slot minorGrid '' Number readWrite Player getMinorGrid Player setMinorGrid: )
#(command restoreDefaultGrids '' )
))!
----- Method: BarGraphMorph classSide>>additionsToViewerCategoryPlotLegends (in category 'viewer categories') -----
additionsToViewerCategoryPlotLegends
"This is just to override the #'plot - legends' category (notice the space after grid)"
^#(#'plot - legends ' (
#(slot spacing '' Number readWrite Player getLegendSpacing Player setLegendSpacing: )
))!
----- Method: BarGraphMorph classSide>>additionsToViewerCategoryPlotRange (in category 'viewer categories') -----
additionsToViewerCategoryPlotRange
^#(#'plot - range' (
#(command move: '' Number)
#(command restoreInitialPosition '')
#(slot max '' Number readWrite Player getMax Player setMax: )
#(slot min '' Number readWrite Player getMin Player setMin: )
))!
----- Method: BarGraphMorph classSide>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
^ 'Bar Graph' !
----- Method: BarGraphMorph classSide>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
^ self
partName: 'Bar Graph'
categories: #('GSoC' )
documentation: ''
!
----- Method: BarGraphMorph classSide>>includeInNewMorphMenu (in category 'new-morph participation') -----
includeInNewMorphMenu
"Return true for all classes that can be instantiated from the menu"
^ true!
----- Method: BarGraphMorph classSide>>initialize (in category 'class initialization') -----
initialize
"self initialize"
super initialize.
Vocabulary addStandardVocabulary: (SymbolListType new vocabularyName: #GraphDirection;
symbols: #(#horizontal #vertical )).!
----- Method: BarGraphMorph>>addBar: (in category 'accessing bars') -----
addBar: anAssociation
| m |
m := BarMorph graph: self bar: anAssociation index: self barCount + 1.
self addMorph: m.
barMorphs add: m.
self changed.!
----- Method: BarGraphMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aMenu hand: aHandMorph
aMenu add: 'open bar table' target: self action: #openBarTable!
----- Method: BarGraphMorph>>axisXPos (in category 'calculations') -----
axisXPos
"Returns the horizontal position of the axis. It makes sure that the legends fit in this space"
| font |
font := TextStyle defaultFont.
^self left + ((font widthOfString: self range last ceiling asString) max: (font widthOfString: self range first floor asString)) + 5!
----- Method: BarGraphMorph>>axisYPos (in category 'calculations') -----
axisYPos
"Returns the vertical position of the axis. It makes sure that the legends fit in this space"
^self bottom - TextStyle defaultFont height - 5
!
----- Method: BarGraphMorph>>barAt:ifAbsent: (in category 'accessing bars') -----
barAt: index ifAbsent: aBlock
| m |
m := barMorphs at: index ifAbsent: [nil].
^m isNil ifTrue: [aBlock value] ifFalse: [m bar]
!
----- Method: BarGraphMorph>>barAt:put: (in category 'accessing bars') -----
barAt: index put: anAssociation
(barMorphs at: index ifAbsent: [^self error: 'Bar not found']) bar: anAssociation.!
----- Method: BarGraphMorph>>barColorAt: (in category 'accessing bars') -----
barColorAt: index
^(barMorphs at: index) color!
----- Method: BarGraphMorph>>barColorAt:put: (in category 'accessing bars') -----
barColorAt: index put: aColor
(barMorphs at: index) color: aColor!
----- Method: BarGraphMorph>>barCount (in category 'accessing bars') -----
barCount
^barMorphs size!
----- Method: BarGraphMorph>>bars (in category 'accessing bars') -----
bars
^barMorphs collect: [:each| each bar]!
----- Method: BarGraphMorph>>centerFor:index: (in category 'calculations') -----
centerFor: anAssociation index: index
"Returns the correct center for a bar morph depending on its index and its value"
| x y |
self isVerticalGraph
ifTrue: [x := self axisXPos + (self distanceBetweenBars * index).
y := (self cartesianYToPixel: anAssociation value / 2) rounded]
ifFalse: [x := (self cartesianXToPixel: anAssociation value / 2) rounded.
y := self axisYPos - (self distanceBetweenBars * index)].
^x at y!
----- Method: BarGraphMorph>>distanceBetweenBars (in category 'accessing bars') -----
distanceBetweenBars
^distanceBetweenBars!
----- Method: BarGraphMorph>>distanceBetweenBars: (in category 'accessing bars') -----
distanceBetweenBars: aNumber
distanceBetweenBars := aNumber.
self updateBars!
----- Method: BarGraphMorph>>drawGridForm (in category 'building') -----
drawGridForm
| aCanvas |
"For performance, I keep the background in a separate form and redraw it only when it's necessary (i.e. changing the gridding parameters or the extent of the morph)"
gridForm isNil ifTrue: [^self].
aCanvas := gridForm getCanvas.
aCanvas fillColor: backgroundColor .
self isVerticalGraph ifTrue: [self drawHorizontalGridOn: aCanvas] ifFalse: [self drawVerticalGridOn: aCanvas]!
----- Method: BarGraphMorph>>extentFor: (in category 'calculations') -----
extentFor: anAssociation
"Returns the correct extent for a bar morph depending on its value"
^self isVerticalGraph
ifTrue: [30@((self cartesianYToRelativePixel: 0) - (self cartesianYToRelativePixel: anAssociation value)) abs]
ifFalse: [((self cartesianXToRelativePixel: 0) - (self cartesianXToRelativePixel: anAssociation value)) abs @ 30]!
----- Method: BarGraphMorph>>filterViewerCategoryDictionary: (in category 'initialize-release') -----
filterViewerCategoryDictionary: dict
super filterViewerCategoryDictionary: dict.
dict removeKey: #'plot - coordinate system' ifAbsent: [].
dict removeKey: #'plot - grid' ifAbsent: [].
dict removeKey: #'plot - legends' ifAbsent: [].!
----- Method: BarGraphMorph>>graphDirection (in category 'accessing') -----
graphDirection
^graphDirection!
----- Method: BarGraphMorph>>graphDirection: (in category 'accessing') -----
graphDirection: aSymbol
"graphDirection must be either #vertical or #horizontal"
graphDirection := aSymbol.
self updateAll !
----- Method: BarGraphMorph>>initialize (in category 'initialize-release') -----
initialize
graphDirection := #horizontal.
self initializeBars;
initializeDistanceBetweenBars.
super initialize.!
----- Method: BarGraphMorph>>initializeBars (in category 'initialize-release') -----
initializeBars
barMorphs := OrderedCollection new.!
----- Method: BarGraphMorph>>initializeDistanceBetweenBars (in category 'initialize-release') -----
initializeDistanceBetweenBars
distanceBetweenBars := 45
!
----- Method: BarGraphMorph>>initializeToStandAlone (in category 'initialize-release') -----
initializeToStandAlone
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
self initialize.!
----- Method: BarGraphMorph>>isVerticalGraph (in category 'testing') -----
isVerticalGraph
^graphDirection = #vertical!
----- Method: BarGraphMorph>>legendSpacing (in category 'accessing legends') -----
legendSpacing
^self isVerticalGraph ifTrue: [super legendSpacing y] ifFalse: [super legendSpacing x]!
----- Method: BarGraphMorph>>legendSpacing: (in category 'accessing legends') -----
legendSpacing: aNumber
super legendSpacing: aNumber at aNumber!
----- Method: BarGraphMorph>>majorGrid (in category 'accessing grid') -----
majorGrid
^self isVerticalGraph ifTrue: [super majorGrid y] ifFalse: [super majorGrid x]!
----- Method: BarGraphMorph>>majorGrid: (in category 'accessing grid') -----
majorGrid: aNumber
super majorGrid: aNumber at aNumber!
----- Method: BarGraphMorph>>minorGrid (in category 'accessing grid') -----
minorGrid
^self isVerticalGraph ifTrue: [super minorGrid y] ifFalse: [super minorGrid x]!
----- Method: BarGraphMorph>>minorGrid: (in category 'accessing grid') -----
minorGrid: aNumber
super minorGrid: aNumber at aNumber!
----- Method: BarGraphMorph>>move: (in category 'moving') -----
move: aNumber
self range: ((self range first + aNumber) to: (self range last + aNumber)).
self update!
----- Method: BarGraphMorph>>newPlayerInstance (in category 'initialize-release') -----
newPlayerInstance
^BarGraphPlayer newUserInstance!
----- Method: BarGraphMorph>>openBarTable (in category 'actions') -----
openBarTable
^(BarTableMorph on: self) openInHand!
----- Method: BarGraphMorph>>placeAxes (in category 'building') -----
placeAxes
| axisPos |
self isVerticalGraph
ifTrue: [axisPos := self axisXPos @ (self cartesianYToPixel: 0).]
ifFalse: [axisPos := (self cartesianXToPixel: 0) @ self axisYPos.].
verticalAxis vertices at: 1 put: axisPos x @ self bottom.
verticalAxis vertices at: 2 put: axisPos x @ self top.
verticalAxis borderColor: axisColor.
verticalAxis computeBounds.
horizontalAxis vertices at: 1 put: self left @ axisPos y.
horizontalAxis vertices at: 2 put: self right @ axisPos y.
horizontalAxis borderColor: axisColor.
horizontalAxis computeBounds!
----- Method: BarGraphMorph>>placeXLegends (in category 'building') -----
placeXLegends
self isVerticalGraph
ifTrue: [(legends at: #x) do: [:each | each delete].
legends at: #x put: OrderedCollection new.
^self].
super placeXLegends!
----- Method: BarGraphMorph>>placeYLegends (in category 'building') -----
placeYLegends
self isVerticalGraph
ifFalse: [(legends at: #y) do: [:each | each delete].
legends at: #y put: OrderedCollection new.
^self].
self placeYLegendsIncludeZero!
----- Method: BarGraphMorph>>placeYLegendsIncludeZero (in category 'building') -----
placeYLegendsIncludeZero
"Almost like super>>#placeYLegends but this includes the zero"
| index yLegends legendPos legend |
index := 0.
yLegends := legends at: #y.
cartesianBounds top ceiling to: cartesianBounds bottom floor do: [:y |
| pos |
pos := self cartesianYToPixel: y.
(y isDivisibleBy: legendSpacing y)
ifTrue: [
legendPos := (self preferredPositionForYLegend: y asString at: pos).
legendPos notNil ifTrue: [
legend := yLegends at: (index := index + 1) ifAbsent: [yLegends add: StringMorph new].
self addMorph: legend.
legend contents: y asString; position: legendPos; color: axisColor]]].
yLegends isEmpty ifFalse: [
yLegends from: index + 1 to: yLegends size do: [:each| each delete].
yLegends removeLast: (yLegends size - index)]!
----- Method: BarGraphMorph>>range (in category 'accessing range') -----
range
self isVerticalGraph
ifTrue: [^cartesianBounds top to: cartesianBounds bottom]
ifFalse: [^cartesianBounds left to: cartesianBounds right]
!
----- Method: BarGraphMorph>>range: (in category 'accessing range') -----
range: anInterval
self cartesianBounds: ((anInterval first @ anInterval first) corner: (anInterval last @ anInterval last)).!
----- Method: BarGraphMorph>>removeAllBars (in category 'accessing bars') -----
removeAllBars
barMorphs do: [:each| each delete].
self initializeBars!
----- Method: BarGraphMorph>>removeBar: (in category 'accessing bars') -----
removeBar: anAssoc
| m |
m := barMorphs select: [:each| each bar = anAssoc].
m isEmpty ifTrue: [^self error: 'Bar not found'].
barMorphs remove: m anyOne delete.
self updateBars!
----- Method: BarGraphMorph>>removeBarAt: (in category 'accessing bars') -----
removeBarAt: index
| m |
m := barMorphs at: index ifAbsent: [^self error: 'Bar not found'].
m delete.
barMorphs removeAt: index.
self updateBars!
----- Method: BarGraphMorph>>removeBarsFrom:to: (in category 'accessing bars') -----
removeBarsFrom: start to: stop
| removed |
removed := OrderedCollection new.
start to: stop do: [:i|
removed add: (barMorphs at: i) delete.
].
barMorphs removeAllFoundIn: removed.
self updateBars.!
----- Method: BarGraphMorph>>restoreInitialPosition (in category 'accessing range') -----
restoreInitialPosition
self range: (-1 to: 19); update!
----- Method: BarGraphMorph>>updateAll (in category 'updating') -----
updateAll
super updateAll.
self updateBars; changed!
----- Method: BarGraphMorph>>updateBars (in category 'updating') -----
updateBars
| index |
index := 0.
barMorphs do: [:each| each update: (index := index + 1)].
self changed!
----- Method: CartesianGraphMorph classSide>>additionsToViewerCategoryPlotColors (in category 'viewer categories') -----
additionsToViewerCategoryPlotColors
^#(#'plot - colors' (
#(slot axisColor '' Color readWrite Player getAxisColor Player setAxisColor: )
#(slot backgroundColor '' Color readWrite Player getBackgroundColor Player setBackgroundColor: )
#(slot majorGridColor '' Color readWrite Player getMajorGridColor Player setMajorGridColor: )
#(slot minorGridColor '' Color readWrite Player getMinorGridColor Player setMinorGridColor: )
#(command restoreDefaultColors '' )
))!
----- Method: CartesianGraphMorph classSide>>additionsToViewerCategoryPlotCoordinateSystem (in category 'viewer categories') -----
additionsToViewerCategoryPlotCoordinateSystem
^#(#'plot - coordinate system' (
#(command moveLeft: '' Number)
#(command moveRight: '' Number)
#(command moveUp: '' Number)
#(command moveDown: '' Number)
#(command restoreInitialPosition '')
#(slot xMax '' Number readWrite Player getXMax Player setXMax: )
#(slot xMin '' Number readWrite Player getXMin Player setXMin: )
#(slot yMax '' Number readWrite Player getYMax Player setYMax: )
#(slot yMin '' Number readWrite Player getYMin Player setYMin: )
))!
----- Method: CartesianGraphMorph classSide>>additionsToViewerCategoryPlotGrid (in category 'viewer categories') -----
additionsToViewerCategoryPlotGrid
^#(#'plot - grid' (
#(slot xMajorGrid '' Number readWrite Player getXMajorGrid Player setXMajorGrid: )
#(slot xMinorGrid '' Number readWrite Player getXMinorGrid Player setXMinorGrid: )
#(slot yMajorGrid '' Number readWrite Player getYMajorGrid Player setYMajorGrid: )
#(slot yMinorGrid '' Number readWrite Player getYMinorGrid Player setYMinorGrid: )
#(command restoreDefaultGrids '' )
))!
----- Method: CartesianGraphMorph classSide>>additionsToViewerCategoryPlotLegends (in category 'viewer categories') -----
additionsToViewerCategoryPlotLegends
^#(#'plot - legends' (
#(slot xSpacing '' Number readWrite Player getXLegendSpacing Player setXLegendSpacing: )
#(slot ySpacing '' Number readWrite Player getYLegendSpacing Player setYLegendSpacing: )
))!
----- Method: CartesianGraphMorph classSide>>includeInNewMorphMenu (in category 'new-morph participation') -----
includeInNewMorphMenu
"Return true for all classes that can be instantiated from the menu"
^ false!
----- Method: CartesianGraphMorph>>axisColor (in category 'accessing colors') -----
axisColor
^axisColor!
----- Method: CartesianGraphMorph>>axisColor: (in category 'accessing colors') -----
axisColor: aColor
axisColor := aColor.
self updateBackground.!
----- Method: CartesianGraphMorph>>backgroundColor (in category 'accessing colors') -----
backgroundColor
^backgroundColor!
----- Method: CartesianGraphMorph>>backgroundColor: (in category 'accessing colors') -----
backgroundColor: aColor
backgroundColor := aColor.
self updateBackground.!
----- Method: CartesianGraphMorph>>cartesianBounds (in category 'accessing cartesian bounds') -----
cartesianBounds
^cartesianBounds!
----- Method: CartesianGraphMorph>>cartesianBounds: (in category 'accessing cartesian bounds') -----
cartesianBounds: aRectangle
self controlCartesianBounds: aRectangle.
cartesianBounds := aRectangle.
self update!
----- Method: CartesianGraphMorph>>cartesianPointToPixel: (in category 'calculations') -----
cartesianPointToPixel: aPoint
^(self cartesianXToPixel: aPoint x) @ (self cartesianYToPixel: aPoint y)!
----- Method: CartesianGraphMorph>>cartesianPointToRelativePixel: (in category 'calculations') -----
cartesianPointToRelativePixel: aPoint
^(self cartesianXToRelativePixel: aPoint x) @ (self cartesianYToRelativePixel: aPoint y)!
----- Method: CartesianGraphMorph>>cartesianXToPixel: (in category 'calculations') -----
cartesianXToPixel: aNumber
^ (bounds left + (aNumber - cartesianBounds left * bounds width / cartesianBounds width)) rounded.
!
----- Method: CartesianGraphMorph>>cartesianXToRelativePixel: (in category 'calculations') -----
cartesianXToRelativePixel: aNumber
^ (aNumber - cartesianBounds left * bounds width / cartesianBounds width) rounded.
!
----- Method: CartesianGraphMorph>>cartesianYToPixel: (in category 'calculations') -----
cartesianYToPixel: aNumber
^ (bounds bottom - (aNumber - cartesianBounds top * bounds height / cartesianBounds height)) rounded.
!
----- Method: CartesianGraphMorph>>cartesianYToRelativePixel: (in category 'calculations') -----
cartesianYToRelativePixel: aNumber
^ (self height - (aNumber - cartesianBounds top * bounds height / cartesianBounds height)) rounded.
!
----- Method: CartesianGraphMorph>>controlCartesianBounds: (in category 'controlling errors') -----
controlCartesianBounds: aRectangle
aRectangle right <= aRectangle left ifTrue: [^self error: 'x range error'].
aRectangle bottom <= aRectangle top ifTrue: [^self error: 'y range error'].!
----- Method: CartesianGraphMorph>>controlGriddingParameter: (in category 'controlling errors') -----
controlGriddingParameter: aPoint
| |
(aPoint x isInteger and: [aPoint y isInteger]) ifFalse: [^self error: 'Gridding parameters must be natural numbers'].
(aPoint x < 0 or: [aPoint y < 0]) ifTrue: [^self error: 'Gridding parameters must be natural numbers'].!
----- Method: CartesianGraphMorph>>controlLegendSpacing: (in category 'controlling errors') -----
controlLegendSpacing: aPoint
| |
(aPoint x isInteger and: [aPoint y isInteger]) ifFalse: [^self error: 'Legend spacing must be natural numbers'].
(aPoint x < 0 or: [aPoint y < 0]) ifTrue: [^self error: 'Legend spacing must be natural numbers'].!
----- Method: CartesianGraphMorph>>delete (in category 'initialize-release') -----
delete
self submorphsDo: [:each| each delete].
super delete!
----- Method: CartesianGraphMorph>>drawGridForm (in category 'building') -----
drawGridForm
| aCanvas |
"For performance, I keep the background in a separate form and redraw it only when it's necessary (i.e. changing the gridding parameters or the extent of the morph)"
gridForm isNil ifTrue: [^self].
aCanvas := gridForm getCanvas.
aCanvas fillColor: backgroundColor .
self drawVerticalGridOn: aCanvas; drawHorizontalGridOn: aCanvas!
----- Method: CartesianGraphMorph>>drawHorizontalGridOn: (in category 'building') -----
drawHorizontalGridOn: aCanvas
cartesianBounds top ceiling to: cartesianBounds bottom floor do: [:y |
| gridPos |
gridPos := self cartesianYToRelativePixel: y.
(y isDivisibleBy: minorGrid y)
ifTrue: [self drawMinorGridFrom: 0 @ gridPos to: (gridForm width - 1) @ gridPos on: aCanvas].
(y isDivisibleBy: majorGrid y)
ifTrue: [self drawMajorGridFrom: 0 @ gridPos to: (gridForm width - 1) @ gridPos on: aCanvas].
].!
----- Method: CartesianGraphMorph>>drawMajorGridFrom:to:on: (in category 'building') -----
drawMajorGridFrom: p1 to: p2 on: aCanvas.
((gridForm boundingBox containsPoint: p1) and: [gridForm boundingBox containsPoint: p2])
ifFalse: [^self].
aCanvas
line: p1
to: p2
width: 1
color: majorGridColor
stepWidth: 2
secondWidth: 1
secondColor: backgroundColor
secondStepWidth: 2!
----- Method: CartesianGraphMorph>>drawMinorGridFrom:to:on: (in category 'building') -----
drawMinorGridFrom: p1 to: p2 on: aCanvas
((gridForm boundingBox containsPoint: p1) and: [gridForm boundingBox containsPoint: p2])
ifFalse: [^self].
aCanvas
line: p1
to: p2
width: 1
color: minorGridColor
stepWidth: 1
secondWidth: 1
secondColor: backgroundColor
secondStepWidth: 6!
----- Method: CartesianGraphMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
super drawOn: aCanvas.
aCanvas drawImage: gridForm at: bounds topLeft.
aCanvas frameRectangle: bounds color: self borderColor.!
----- Method: CartesianGraphMorph>>drawSubmorphsOn: (in category 'drawing') -----
drawSubmorphsOn: aCanvas
"Display submorphs back to front"
| drawBlock |
submorphs isEmpty ifTrue: [^self].
drawBlock := [:canvas | submorphs reverseDo: [:m | canvas fullDrawMorph: m]].
self clipSubmorphs
ifTrue: [aCanvas clipBy: self clippingBounds during: drawBlock]
ifFalse: [drawBlock value: aCanvas]!
----- Method: CartesianGraphMorph>>drawVerticalGridOn: (in category 'building') -----
drawVerticalGridOn: aCanvas
cartesianBounds left ceiling to: cartesianBounds right floor do: [:x |
| gridPos |
gridPos := self cartesianXToRelativePixel: x.
(x isDivisibleBy: minorGrid x)
ifTrue: [self drawMinorGridFrom: gridPos @ (gridForm height - 1) to: gridPos @ 0 on: aCanvas].
(x isDivisibleBy: majorGrid x)
ifTrue: [self drawMajorGridFrom: gridPos @ (gridForm height - 1) to: gridPos @ 0 on: aCanvas].
].!
----- Method: CartesianGraphMorph>>extent: (in category 'accessing') -----
extent: newExtent
"I resize all forms to the newExtent, but (since this method is called in #initialize) I check that backbroundForm was properly initialized before, otherwise it throws an error"
super extent: newExtent.
gridForm isNil ifTrue: [^self].
self initializeGridForm; update!
----- Method: CartesianGraphMorph>>initialize (in category 'initialize-release') -----
initialize
super initialize.
self clipSubmorphs: true; extent: 600 at 600; color: Color white; borderColor: Color gray;
initializeCartesianBounds;
initializeLegendSpacing;
initializeColors;
initializeAxes;
initializeGrids;
initializeLegends!
----- Method: CartesianGraphMorph>>initializeAxes (in category 'initialize-release') -----
initializeAxes
verticalAxis := PolygonMorph arrowPrototype arrowSpec: 8 @ 4; lineBorderWidth: 1.
horizontalAxis := PolygonMorph arrowPrototype arrowSpec: 8 @ 4; lineBorderWidth: 1.
self addMorph: horizontalAxis;
addMorph: verticalAxis.
self updateAxes !
----- Method: CartesianGraphMorph>>initializeCartesianBounds (in category 'initialize-release') -----
initializeCartesianBounds
cartesianBounds := -1 at -1 corner: 19 at 19.!
----- Method: CartesianGraphMorph>>initializeColors (in category 'initialize-release') -----
initializeColors
backgroundColor := Color white.
minorGridColor := Color gray.
majorGridColor := Color gray.
axisColor := Color black.
!
----- Method: CartesianGraphMorph>>initializeGridForm (in category 'initialize-release') -----
initializeGridForm
gridForm := Form extent: self extent depth: 32.!
----- Method: CartesianGraphMorph>>initializeGrids (in category 'initialize-release') -----
initializeGrids
minorGrid := 1 at 1.
majorGrid := 5 at 5.
self initializeGridForm; drawGridForm!
----- Method: CartesianGraphMorph>>initializeLegendSpacing (in category 'initialize-release') -----
initializeLegendSpacing
legendSpacing := 5 at 5!
----- Method: CartesianGraphMorph>>initializeLegends (in category 'initialize-release') -----
initializeLegends
legends := Dictionary new at: #x put: OrderedCollection new;
at: #y put: OrderedCollection new;
yourself.
self placeXLegends; placeYLegends !
----- Method: CartesianGraphMorph>>legendSpacing (in category 'accessing legends') -----
legendSpacing
^legendSpacing!
----- Method: CartesianGraphMorph>>legendSpacing: (in category 'accessing legends') -----
legendSpacing: aPoint
self controlLegendSpacing: aPoint.
legendSpacing := aPoint.
self updateBackground!
----- Method: CartesianGraphMorph>>majorGrid (in category 'accessing grid') -----
majorGrid
^majorGrid!
----- Method: CartesianGraphMorph>>majorGrid: (in category 'accessing grid') -----
majorGrid: aPoint
self controlGriddingParameter: aPoint.
majorGrid := aPoint.
self updateBackground !
----- Method: CartesianGraphMorph>>majorGridColor (in category 'accessing colors') -----
majorGridColor
^majorGridColor!
----- Method: CartesianGraphMorph>>majorGridColor: (in category 'accessing colors') -----
majorGridColor: aColor
majorGridColor := aColor.
self updateBackground.!
----- Method: CartesianGraphMorph>>minorGrid (in category 'accessing grid') -----
minorGrid
^minorGrid!
----- Method: CartesianGraphMorph>>minorGrid: (in category 'accessing grid') -----
minorGrid: aPoint
self controlGriddingParameter: aPoint.
minorGrid := aPoint.
self updateBackground!
----- Method: CartesianGraphMorph>>minorGridColor (in category 'accessing colors') -----
minorGridColor
^minorGridColor!
----- Method: CartesianGraphMorph>>minorGridColor: (in category 'accessing colors') -----
minorGridColor: aColor
minorGridColor := aColor.
self updateBackground.!
----- Method: CartesianGraphMorph>>move: (in category 'moving') -----
move: aPoint
cartesianBounds := cartesianBounds translateBy: aPoint.
self translateTurtleTrailsBy: aPoint; update!
----- Method: CartesianGraphMorph>>newPlayerInstance (in category 'initialize-release') -----
newPlayerInstance
^ CartesianGraphPlayer newUserInstance!
----- Method: CartesianGraphMorph>>placeAxes (in category 'building') -----
placeAxes
| axisPos |
axisPos := self cartesianPointToPixel: 0 at 0.
verticalAxis vertices at: 1 put: axisPos x @ self bottom.
verticalAxis vertices at: 2 put: axisPos x @ self top.
verticalAxis borderColor: axisColor.
verticalAxis computeBounds.
horizontalAxis vertices at: 1 put: self left @ axisPos y.
horizontalAxis vertices at: 2 put: self right @ axisPos y.
horizontalAxis borderColor: axisColor.
horizontalAxis computeBounds!
----- Method: CartesianGraphMorph>>placeXLegends (in category 'building') -----
placeXLegends
| index legendPos legend xLegends |
index := 0.
xLegends := legends at: #x.
cartesianBounds left ceiling to: cartesianBounds right floor do: [:x |
| pos |
pos := self cartesianXToPixel: x.
(x isDivisibleBy: legendSpacing x)
ifTrue: [
legendPos := (self preferredPositionForXLegend: x asString at: pos).
legendPos notNil ifTrue: [
legend := xLegends at: (index := index + 1) ifAbsent: [xLegends add: StringMorph new].
self addMorph: legend.
legend contents: x asString; position: legendPos; color: axisColor]]].
xLegends isEmpty ifFalse: [
xLegends from: index + 1 to: xLegends size do: [:each | each delete].
xLegends removeLast: (xLegends size - index)]!
----- Method: CartesianGraphMorph>>placeYLegends (in category 'building') -----
placeYLegends
| index yLegends legendPos legend |
index := 0.
yLegends := legends at: #y.
cartesianBounds top ceiling to: cartesianBounds bottom floor do: [:y |
| pos |
pos := self cartesianYToPixel: y.
(y ~= 0 and: [(y isDivisibleBy: legendSpacing y)])
ifTrue: [
legendPos := (self preferredPositionForYLegend: y asString at: pos).
legendPos notNil ifTrue: [
legend := yLegends at: (index := index + 1) ifAbsent: [yLegends add: StringMorph new].
self addMorph: legend.
legend contents: y asString; position: legendPos; color: axisColor]]].
yLegends isEmpty ifFalse: [
yLegends from: index + 1 to: yLegends size do: [:each| each delete].
yLegends removeLast: (yLegends size - index)]!
----- Method: CartesianGraphMorph>>preferredPositionForXLegend:at: (in category 'building') -----
preferredPositionForXLegend: legendString at: gridPos
"The preferred position is below the horizontal axis at the right of the major grid.
If nothing can be drawn return nil"
| preferredPosition font axis stringWidth |
font := TextStyle defaultFont.
stringWidth := (font widthOfString: legendString).
axis := horizontalAxis center y.
preferredPosition := (gridPos @ axis) + ((stringWidth / -2) rounded @ 2).
"If the legend width doesn't fit inside the form"
((gridPos + stringWidth) > self right)
ifTrue: [^ nil "Draw nothing"].
"If the axis is not visible"
(axis < self top or: [axis > self bottom])
ifTrue: [^preferredPosition x @ (self bottom - font height )].
"If the axis is close to the bottom so the legend height doesn't fit inside the form"
(axis > (self bottom - font height))
ifTrue: [^preferredPosition x @ (axis - font height)].
"If the preferred position is perfect :)"
^preferredPosition !
----- Method: CartesianGraphMorph>>preferredPositionForYLegend:at: (in category 'building') -----
preferredPositionForYLegend: legendString at: gridPos
"The preferred position is at the left of the vertical axis and above the major grid.
If nothing can be drawn return nil"
| preferredPosition font axis |
axis := verticalAxis center x.
font := TextStyle defaultFont.
preferredPosition := (axis - (font widthOfString: legendString)) @ (gridPos - (font height / 2)).
"If the legend height doesn't fit inside the form"
(preferredPosition y < self top)
ifTrue: [^ nil "Draw nothing"].
"If the axis is not visible"
(axis < self left or: [axis > self right])
ifTrue: [^self left + 3 @ preferredPosition y].
"If the axis is close to the left so the legend width doesn't fit inside the form"
(preferredPosition x < self left)
ifTrue: [^(axis + 3 @ preferredPosition y) ].
"If the preferred position is perfect :)"
^preferredPosition!
----- Method: CartesianGraphMorph>>relativePixelToCartesianPoint: (in category 'calculations') -----
relativePixelToCartesianPoint: aPoint
^(self relativePixelToCartesianX: aPoint x) @ (self relativePixelToCartesianY: aPoint y)
!
----- Method: CartesianGraphMorph>>relativePixelToCartesianX: (in category 'calculations') -----
relativePixelToCartesianX: anInteger
^cartesianBounds left + (anInteger * cartesianBounds width / bounds width)!
----- Method: CartesianGraphMorph>>relativePixelToCartesianY: (in category 'calculations') -----
relativePixelToCartesianY: anInteger
^cartesianBounds top + ((bounds height - anInteger) * cartesianBounds height / bounds height)!
----- Method: CartesianGraphMorph>>restoreDefaultColors (in category 'accessing colors') -----
restoreDefaultColors
self initializeColors; updateBackground!
----- Method: CartesianGraphMorph>>restoreDefaultGrids (in category 'accessing grid') -----
restoreDefaultGrids
self initializeGrids; updateBackground!
----- Method: CartesianGraphMorph>>restoreInitialPosition (in category 'accessing cartesian bounds') -----
restoreInitialPosition
"self initializeCartesianBounds."
| originalBounds |
originalBounds := -1 at -1 corner: 19 at 19.
self move: originalBounds center - cartesianBounds center.
self update!
----- Method: CartesianGraphMorph>>translateTurtleTrailsBy: (in category 'moving') -----
translateTurtleTrailsBy: aPoint
| newForm |
turtleTrailsForm ifNil: [^self].
newForm := turtleTrailsForm blankCopyOf: turtleTrailsForm scaledBy: 1.
turtleTrailsForm contentsOfArea: (turtleTrailsForm boundingBox translateBy:
(self cartesianPointToRelativePixel: aPoint + cartesianBounds bottomLeft )) into: newForm.
turtleTrailsForm := newForm.
turtlePen := Pen newOnForm: turtleTrailsForm
!
----- Method: CartesianGraphMorph>>update (in category 'updating') -----
update
self updateAll!
----- Method: CartesianGraphMorph>>updateAll (in category 'updating') -----
updateAll
self updateBackground; changed!
----- Method: CartesianGraphMorph>>updateAxes (in category 'updating') -----
updateAxes
| axisPos |
axisPos := self cartesianPointToPixel: 0 at 0.
verticalAxis vertices at: 1 put: axisPos x @ self bottom.
verticalAxis vertices at: 2 put: axisPos x @ self top.
verticalAxis borderColor: axisColor.
verticalAxis computeBounds.
horizontalAxis vertices at: 1 put: self left @ axisPos y.
horizontalAxis vertices at: 2 put: self right @ axisPos y.
horizontalAxis borderColor: axisColor.
horizontalAxis computeBounds!
----- Method: CartesianGraphMorph>>updateBackground (in category 'updating') -----
updateBackground
self drawGridForm; placeAxes; placeXLegends; placeYLegends; changed!
CartesianGraphMorph subclass: #DataGraphMorph
instanceVariableNames: 'vectorMorphs pointMorphs'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!DataGraphMorph commentStamp: 'Richo 5/21/2010 08:57' prior: 0!
This class is responsible of drawing points and vectors in a cartesian coordinate system.
To add points use the following protocol:
#pointAt:
#pointAt:put:
#removePointAt:
#removeAllPoints
To add vectors use the following protocol:
#addVector:
#vectorAt:
#vectorAt:put:
#removeVector:
#removeVectorAt:
#removeAllVectors
For more information, see the "examples" category at the class side.
!
----- Method: DataGraphMorph classSide>>additionsToViewerCategoryPlotPoints (in category 'viewer categories') -----
additionsToViewerCategoryPlotPoints
^#(#'plot - points' (
#(slot pointIndex '' Number readWrite Player getPointIndex Player setPointIndex: )
#(command removePointAt: '' Number )
#(command removeAllPoints '')
#(command removeCurrentPoint '')
#(command addPoint '')
#(slot pointX '' Number readWrite Player getPointX Player setPointX: )
#(slot pointY '' Number readWrite Player getPointY Player setPointY: )
#(command openPointTable '')
#(slot pointCount '' Number readOnly Player getPointCount Player unused )
#(slot pointColor '' Color readWrite Player getPointColor Player setPointColor: )
#(slot playerAtPointIndex '' Player readWrite Player getPlayerAtPointIndex unused unused)
))!
----- Method: DataGraphMorph classSide>>additionsToViewerCategoryPlotVectors (in category 'viewer categories') -----
additionsToViewerCategoryPlotVectors
^#(#'plot - vectors' (
#(slot vectorIndex '' Number readWrite Player getVectorIndex Player setVectorIndex: )
#(command removeVectorAt: '' Number )
#(command removeAllVectors '')
#(command removeCurrentVector '')
#(command addVector '')
#(slot initialPointX '' Number readWrite Player getInitialPointX Player setInitialPointX: )
#(slot initialPointY '' Number readWrite Player getInitialPointY Player setInitialPointY: )
#(slot terminalPointX '' Number readWrite Player getTerminalPointX Player setTerminalPointX: )
#(slot terminalPointY '' Number readWrite Player getTerminalPointY Player setTerminalPointY: )
#(slot vectorMagnitude '' Number readWrite Player getVectorMagnitude Player setVectorMagnitude: )
#(slot vectorAngle '' Number readWrite Player getVectorAngle Player setVectorAngle: )
#(slot vectorCount '' Number readOnly Player getVectorCount Player unused )
#(slot vectorColor '' Color readWrite Player getVectorColor Player setVectorColor: )
#(slot playerAtVectorIndex '' Player readWrite Player getPlayerAtVectorIndex unused unused)
))!
----- Method: DataGraphMorph classSide>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
^ 'Graph' !
----- Method: DataGraphMorph classSide>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
^ self
partName: 'Graph'
categories: #('GSoC' )
documentation: ''
!
----- Method: DataGraphMorph classSide>>examplePoints (in category 'examples') -----
examplePoints
"To watch the example simply execute (Cmd-d):
self examplePoints
"
| graph |
"Creating the morph and opening it in the world"
graph := DataGraphMorph new.
graph openInHand.
"Setting the grid parameters"
graph minorGrid: 2 at 3.
graph majorGrid: 4 at 6.
"Setting the legend spacing"
graph legendSpacing: 8 at 6.
"Setting the x/y range"
graph cartesianBounds: ((-15 at -15) corner: (15 at 15)).
"Changing the default colors"
graph backgroundColor: Color black.
graph minorGridColor: Color cyan.
graph majorGridColor: Color magenta.
graph axisColor: Color white.
"Ploting a sine wave"
-15 to: 15 by: 0.5 do: [:x|
graph addPoint: x @ (x sin).
].!
----- Method: DataGraphMorph classSide>>exampleVectors (in category 'examples') -----
exampleVectors
"To watch the example simply execute (Cmd-d):
self exampleVectors
"
| graph |
"Creating the morph and opening it in the world"
graph := DataGraphMorph new.
graph openInHand.
"Changing the minor grid"
graph minorGrid: 0 at 0.
"Adding a vector"
graph addVector: (Vector terminalPoint: 10 at 5).
graph vectorColorAt: 1 put: Color red muchDarker.
"Adding another vector"
graph addVector: (Vector terminalPoint: 3 at 10).
graph vectorColorAt: 2 put: Color red.
"Adding the sum of the vectors above"
graph addVector: (Vector terminalPoint: 13 at 15).
graph vectorColorAt: 3 put: Color red muchLighter.
"Adding two additional vectors"
graph addVector: ((3 at 10) to: (13 at 15)).
graph vectorColorAt: 4 put: Color red muchDarker.
graph addVector: ((10 at 5) to: (13 at 15)).
graph vectorColorAt: 5 put: Color red.!
----- Method: DataGraphMorph classSide>>includeInNewMorphMenu (in category 'new-morph participation') -----
includeInNewMorphMenu
"Return true for all classes that can be instantiated from the menu"
^ true!
----- Method: DataGraphMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aMenu hand: aHandMorph
aMenu add: 'open point table' target: self action: #openPointTable!
----- Method: DataGraphMorph>>addPoint: (in category 'accessing points') -----
addPoint: aPoint
| m |
m := PointMorph graph: self point: aPoint.
self addMorph: m.
pointMorphs add: m.!
----- Method: DataGraphMorph>>addVector: (in category 'accessing vectors') -----
addVector: aVector
| m |
m := VectorMorph graph: self vector: aVector.
self addMorph: m.
vectorMorphs add: m.
!
----- Method: DataGraphMorph>>indexOfVector: (in category 'accessing vectors') -----
indexOfVector: aVector
| index |
index := 0.
vectorMorphs do: [:each|
index := index + 1.
each vector = aVector
ifTrue: [
^index
]
].
^0!
----- Method: DataGraphMorph>>initialize (in category 'initialize') -----
initialize
super initialize.
self
initializePoints;
initializeVectors.
!
----- Method: DataGraphMorph>>initializePoints (in category 'initialize') -----
initializePoints
pointMorphs := OrderedCollection new!
----- Method: DataGraphMorph>>initializeToStandAlone (in category 'initialize') -----
initializeToStandAlone
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
self initialize.!
----- Method: DataGraphMorph>>initializeVectors (in category 'initialize') -----
initializeVectors
vectorMorphs := OrderedCollection new !
----- Method: DataGraphMorph>>newPlayerInstance (in category 'initialize') -----
newPlayerInstance
^ DataGraphPlayer newUserInstance!
----- Method: DataGraphMorph>>openPointTable (in category 'actions') -----
openPointTable
(PointTableMorph on: self) openInHand!
----- Method: DataGraphMorph>>pointAt: (in category 'accessing points') -----
pointAt: index
^(pointMorphs at: index) point!
----- Method: DataGraphMorph>>pointAt:ifAbsent: (in category 'accessing points') -----
pointAt: index ifAbsent: aBlock
| m |
m := pointMorphs at: index ifAbsent: [nil].
^m isNil ifTrue: [aBlock value] ifFalse: [m point]
!
----- Method: DataGraphMorph>>pointAt:put: (in category 'accessing points') -----
pointAt: index put: aPoint
(pointMorphs at: index ifAbsent: [^self error: 'Point not found']) point: aPoint.!
----- Method: DataGraphMorph>>pointColorAt: (in category 'accessing points') -----
pointColorAt: index
^(pointMorphs at: index) color!
----- Method: DataGraphMorph>>pointColorAt:put: (in category 'accessing points') -----
pointColorAt: index put: aColor
(pointMorphs at: index) color: aColor!
----- Method: DataGraphMorph>>pointCount (in category 'accessing points') -----
pointCount
^pointMorphs size!
----- Method: DataGraphMorph>>pointMorphAt: (in category 'accessing points') -----
pointMorphAt: index
^pointMorphs at: index ifAbsent: [nil]!
----- Method: DataGraphMorph>>points (in category 'accessing points') -----
points
^pointMorphs collect: [:each| each point]!
----- Method: DataGraphMorph>>removeAllPoints (in category 'accessing points') -----
removeAllPoints
pointMorphs do: [:each| each delete].
self initializePoints !
----- Method: DataGraphMorph>>removeAllVectors (in category 'accessing vectors') -----
removeAllVectors
vectorMorphs do: [:each| each delete].
self initializeVectors!
----- Method: DataGraphMorph>>removePoint: (in category 'accessing points') -----
removePoint: aPoint
| p |
p := pointMorphs select: [:each| each point = aPoint].
p isEmpty ifTrue: [^self error: 'Point not found'].
pointMorphs remove: p anyOne delete.!
----- Method: DataGraphMorph>>removePointAt: (in category 'accessing points') -----
removePointAt: index
| p |
p := pointMorphs at: index ifAbsent: [^self error: 'Point not found'].
p delete.
pointMorphs removeAt: index.!
----- Method: DataGraphMorph>>removePointsFrom:to: (in category 'accessing points') -----
removePointsFrom: start to: stop
| removed |
removed := OrderedCollection new.
start to: stop do: [:i|
removed add: (pointMorphs at: i) delete.
].
pointMorphs removeAllFoundIn: removed!
----- Method: DataGraphMorph>>removeVector: (in category 'accessing vectors') -----
removeVector: aVector
| v |
v := vectorMorphs select: [:each| each vector = aVector].
v isEmpty ifTrue: [^self error: 'Vector not found'].
vectorMorphs remove: v anyOne delete.!
----- Method: DataGraphMorph>>removeVectorAt: (in category 'accessing vectors') -----
removeVectorAt: index
| m |
m := vectorMorphs at: index ifAbsent: [^self error: 'Vector not found'].
m delete.
vectorMorphs removeAt: index.
!
----- Method: DataGraphMorph>>updateAll (in category 'updating') -----
updateAll
super updateAll.
self updatePoints; updateVectors; changed!
----- Method: DataGraphMorph>>updatePoints (in category 'updating') -----
updatePoints
"Updates the position of each point"
pointMorphs do: [:each | each update].
self changed!
----- Method: DataGraphMorph>>updateVectors (in category 'updating') -----
updateVectors
"Updates the position of each vector"
vectorMorphs do: [:each | each update].
self changed!
----- Method: DataGraphMorph>>vectorAt: (in category 'accessing vectors') -----
vectorAt: index
^(vectorMorphs at: index) vector!
----- Method: DataGraphMorph>>vectorAt:ifAbsent: (in category 'accessing vectors') -----
vectorAt: index ifAbsent: aBlock
| m |
m := vectorMorphs at: index ifAbsent: [nil].
^m isNil ifTrue: [aBlock value] ifFalse: [m vector]
!
----- Method: DataGraphMorph>>vectorAt:put: (in category 'accessing vectors') -----
vectorAt: index put: aVector
(vectorMorphs at: index ifAbsent: [^self error: 'Vector not found']) vector: aVector.!
----- Method: DataGraphMorph>>vectorColorAt: (in category 'accessing vectors') -----
vectorColorAt: index
^(vectorMorphs at: index) color!
----- Method: DataGraphMorph>>vectorColorAt:put: (in category 'accessing vectors') -----
vectorColorAt: index put: aColor
(vectorMorphs at: index) color: aColor!
----- Method: DataGraphMorph>>vectorCount (in category 'accessing vectors') -----
vectorCount
^vectorMorphs size!
----- Method: DataGraphMorph>>vectorMorphAt: (in category 'accessing vectors') -----
vectorMorphAt: index
^vectorMorphs at: index ifAbsent: [nil]!
----- Method: Point>>to: (in category '*GSoC-Graphing') -----
to: aPoint
^Vector initialPoint: self terminalPoint: aPoint!
Object subclass: #Vector
instanceVariableNames: 'initialPoint terminalPoint'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
!Vector commentStamp: 'Richo 4/18/2010 00:23' prior: 0!
This class represents a Vector. It lets you define initial point, terminal point, magnitude, and angle. Every point is inmutable.
To create a Vector you have the following protocol:
Vector angle: 45 magnitude: 5.
Vector terminalPoint: 10 at 10
Vector initialPoint: 5 at 5 angle: 45 magnitude: 5.
Vector initialPoint: 5 at 5 terminalPoint: 10 at 10.
If the initial point is not specified it uses 0 at 0. It is also possible to create a Vector using the Point's special message #to:
((5 at 5) to: (10 at 10))!
----- Method: Vector classSide>>angle:magnitude: (in category 'instance creation') -----
angle: degrees magnitude: magnitude
^self initialPoint: 0 at 0 angle: degrees magnitude: magnitude!
----- Method: Vector classSide>>initialPoint:angle:magnitude: (in category 'instance creation') -----
initialPoint: initialPoint angle: degrees magnitude: magnitude
| o a |
o := degrees degreesToRadians sin * magnitude.
a := degrees degreesToRadians cos * magnitude.
^self initialPoint: initialPoint terminalPoint: (initialPoint + (a at o))!
----- Method: Vector classSide>>initialPoint:terminalPoint: (in category 'instance creation') -----
initialPoint: initialPoint terminalPoint: terminalPoint
^(self basicNew setInitialPoint: initialPoint terminalPoint: terminalPoint) initialize!
----- Method: Vector classSide>>terminalPoint: (in category 'instance creation') -----
terminalPoint: aPoint
^self initialPoint: 0 at 0 terminalPoint: aPoint!
----- Method: Vector>>= (in category 'comparing') -----
= anotherObject
(anotherObject isKindOf: self class)
ifFalse: [^ false].
^initialPoint = anotherObject initialPoint and: [terminalPoint = anotherObject terminalPoint]!
----- Method: Vector>>angle (in category 'accessing') -----
angle
"Returns an angle in degrees from 0 to 360"
| angle diff |
diff := terminalPoint - initialPoint.
diff x = 0 ifTrue: [diff y >= 0 ifTrue: [^90] ifFalse: [^270]].
angle := (diff y abs / diff x abs) arcTan radiansToDegrees.
diff x > 0 ifTrue: [
diff y >= 0 ifFalse: [angle := 360 - angle]
]
ifFalse: [
diff y >= 0 ifTrue: [angle := 180 - angle] ifFalse: [angle := 180 + angle]
].
^angle!
----- Method: Vector>>hash (in category 'comparing') -----
hash
^initialPoint hash bitXor: terminalPoint hash!
----- Method: Vector>>initialPoint (in category 'accessing') -----
initialPoint
^initialPoint!
----- Method: Vector>>magnitude (in category 'accessing') -----
magnitude
| diff |
diff := terminalPoint - initialPoint.
^(diff x squared + diff y squared) sqrt!
----- Method: Vector>>printOn: (in category 'printing') -----
printOn: aStream
aStream nextPut: $(.
initialPoint printOn: aStream.
aStream nextPut: $).
aStream nextPutAll: ' to: '.
aStream nextPut: $(.
terminalPoint printOn: aStream.
aStream nextPut: $).
!
----- Method: Vector>>setInitialPoint:terminalPoint: (in category 'private') -----
setInitialPoint: aPoint terminalPoint: anotherPoint
initialPoint := aPoint.
terminalPoint := anotherPoint!
----- Method: Vector>>terminalPoint (in category 'accessing') -----
terminalPoint
^terminalPoint !
RectangleMorph subclass: #BarMorph
instanceVariableNames: 'graph bar index labelMorph'
classVariableNames: ''
poolDictionaries: ''
category: 'GSoC-Graphing'!
----- Method: BarMorph classSide>>additionsToViewerCategories (in category 'viewer categories') -----
additionsToViewerCategories
^ #(
(#plot (
#(slot barLabel '' String readWrite Player getBarLabel Player setBarLabel: )
#(slot barValue '' Number readWrite Player getBarValue Player setBarValue: )
#(slot barColor '' Color readWrite Player getBarColor Player setBarColor: )
#(command remove '' )
))
)!
----- Method: BarMorph classSide>>graph:bar:index: (in category 'instance creation') -----
graph: aBarGraphMorph bar: anAssociation index: aNumber
^(self basicNew setGraph: aBarGraphMorph bar: anAssociation index: aNumber) initialize!
----- Method: BarMorph>>bar (in category 'accessing') -----
bar
^bar!
----- Method: BarMorph>>bar: (in category 'accessing') -----
bar: anAssociation
self privateExtent: (graph extentFor: anAssociation);
privateCenter: (graph centerFor: anAssociation index: index);
updateLabel: anAssociation.
bar := anAssociation !
----- Method: BarMorph>>dismissViaHalo (in category 'initialize-release') -----
dismissViaHalo
self remove.
super dismissViaHalo!
----- Method: BarMorph>>extent: (in category 'accessing') -----
extent: aPoint
super extent: aPoint.
owner notNil ifTrue: [self update].
!
----- Method: BarMorph>>initialize (in category 'initialize-release') -----
initialize
super initialize.
self width: 30; color: Color blue muchDarker.
labelMorph := StringMorph new.
self update!
----- Method: BarMorph>>newPlayerInstance (in category 'initialize-release') -----
newPlayerInstance
^BarPlayer newUserInstance!
----- Method: BarMorph>>position: (in category 'accessing') -----
position: aPoint
super position: aPoint.
self update!
----- Method: BarMorph>>privateCenter: (in category 'private') -----
privateCenter: aPoint
self privatePosition: (aPoint - (self extent // 2))!
----- Method: BarMorph>>privateExtent: (in category 'private') -----
privateExtent: aPoint
super extent: aPoint!
----- Method: BarMorph>>privatePosition: (in category 'private') -----
privatePosition: aPoint
super position: aPoint!
----- Method: BarMorph>>remove (in category 'initialize-release') -----
remove
graph removeBar: bar!
----- Method: BarMorph>>setGraph:bar:index: (in category 'private') -----
setGraph: aBarGraphMorph bar: anAssociation index: aNumber
graph := aBarGraphMorph.
bar := anAssociation.
index := aNumber!
----- Method: BarMorph>>update (in category 'initialize-release') -----
update
self update: index!
----- Method: BarMorph>>update: (in category 'initialize-release') -----
update: newIndex
index := newIndex.
self penUpWhile: [self bar: bar].
!
----- Method: BarMorph>>updateLabel: (in category 'accessing') -----
updateLabel: anAssociation
| label value |
label := anAssociation key.
value := anAssociation value.
labelMorph contents: label.
graph isVerticalGraph
ifTrue: [value >= 0
ifTrue: [labelMorph center: self bottomCenter + (0 @ 10)]
ifFalse: [labelMorph center: self topCenter - (0 @ 10)]]
ifFalse: [value <= 0
ifTrue: [labelMorph center: self rightCenter + ((labelMorph width / 2) rounded + 3 @ 0)]
ifFalse: [labelMorph center: self leftCenter - ((labelMorph width / 2) rounded + 3 @ 0).
labelMorph left <= graph left
ifTrue: [labelMorph left: self right + 3]]].
self addMorph: labelMorph.!
More information about the etoys-dev
mailing list