'From Squeak3.2gamma of 15 January 2002 [latest update: #4889] on 16 July 2002 at 7:40:16 am'! MorphicModel subclass: #ArcMorph instanceVariableNames: 'radiansFrom radiansTo title ' classVariableNames: '' poolDictionaries: '' category: 'PieChart'! MorphicModel subclass: #PieChartMorph instanceVariableNames: 'values portions references title ' classVariableNames: '' poolDictionaries: '' category: 'PieChart'! Object subclass: #SemiArc instanceVariableNames: 'radiansFrom radiansTo center radius vertices ' classVariableNames: '' poolDictionaries: '' category: 'PieChart'! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/16/2002 07:22'! color: aColor super color: aColor. self balloonColor: aColor! ! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/9/2002 15:37'! degreesFrom: aNumber self radiansFrom: aNumber degreesToRadians! ! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/9/2002 15:37'! degreesTo: aNumber self radiansTo: aNumber degreesToRadians! ! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/16/2002 07:29'! radiansFrom: aNumber radiansFrom _ aNumber. ! ! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/16/2002 07:29'! radiansTo: aNumber radiansTo _ aNumber. ! ! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/15/2002 23:04'! radius ^ (self width min: self height) // 2 - borderWidth! ! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/9/2002 17:55'! title ^ title! ! !ArcMorph methodsFor: 'accessing' stamp: 'gm 7/9/2002 17:54'! title: aString title _ aString! ! !ArcMorph methodsFor: 'private' stamp: 'gm 7/16/2002 06:18'! calculateVertices | vertices | vertices _ OrderedCollection new. radiansFrom < Float pi & (radiansTo > Float pi) ifTrue: [vertices _ OrderedCollection new. vertices addAll: (SemiArc from: radiansFrom to: Float pi center: self center radius: self radius) vertices. vertices addAll: (SemiArc from: Float pi to: radiansTo center: self center radius: self radius) vertices] ifFalse: [vertices _ (SemiArc from: radiansFrom to: radiansTo center: self center radius: self radius) vertices]. vertices add: self center x @ self center y. ^ vertices! ! !ArcMorph methodsFor: 'private' stamp: 'gm 7/15/2002 23:25'! defaultDiameter ^ self defaultRadius * 2! ! !ArcMorph methodsFor: 'private' stamp: 'gm 7/15/2002 23:25'! defaultRadius ^ 50! ! !ArcMorph methodsFor: 'initialization' stamp: 'gm 7/16/2002 07:23'! initialize super initialize. radiansFrom _ 0. radiansTo _ 2 * Float pi. title _ ''. self height: self defaultDiameter. self width: self defaultDiameter. self color: Color red. self borderWidth: 0! ! !ArcMorph methodsFor: 'initialization' stamp: 'gm 7/15/2002 23:26'! initializeFromDegrees: fromNumber toDegrees: toNumber self initialize. self degreesFrom: fromNumber. self degreesTo: toNumber! ! !ArcMorph methodsFor: 'printing' stamp: 'gm 7/10/2002 19:09'! printOn: aStream aStream nextPutAll: 'from:'; print: radiansFrom; nextPutAll: ' to:'; print: radiansTo; nextPutAll: ' title:'; print: title! ! !ArcMorph methodsFor: 'drawing' stamp: 'gm 7/16/2002 07:29'! drawOn: aCanvas aCanvas drawPolygon: self calculateVertices color: self color borderWidth: self borderWidth borderColor: self borderColor! ! !ArcMorph methodsFor: 'geometry testing' stamp: 'gm 7/16/2002 07:29'! arcContainsPoint: aPoint ^ (PolygonMorph vertices: self calculateVertices color: Color red borderWidth: 1 borderColor: Color blue) containsPoint: aPoint! ! !ArcMorph class methodsFor: 'instance creation' stamp: 'gm 7/9/2002 15:39'! fromDegrees: fromNumber toDegrees: toNumber ^ self new initializeFromDegrees: fromNumber toDegrees: toNumber! ! !PieChartMorph methodsFor: 'initialization' stamp: 'gm 7/9/2002 17:10'! initialize super initialize. self borderWidth: 0. self height: self defaultDiameter. self width: self defaultDiameter. title _ ''. self balloonTextSelector: #title! ! !PieChartMorph methodsFor: 'initialization' stamp: 'gm 7/10/2002 19:15'! initializeValues: aCollection self initialize. values _ aCollection. references _ values collect: [:each | each asString]. self calculatePortions. self colorPortions. self titlePortions. self addPortions! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 7/9/2002 17:51'! addPortions portions do: [:each | self addMorph: each]! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 7/8/2002 22:10'! adjustValues: values | total | total _ values sum. ^ values collect: [:each | each / total * 360]. ! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 7/14/2002 03:33'! balloonText | pointed | pointed _ portions detect: [:each | each arcContainsPoint: self cursorPoint] ifNone: []. pointed isNil ifTrue: [self balloonColor: self defaultBalloonColor. ^ super balloonText] ifFalse: [self balloonColor: pointed color. ^ pointed title]! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 7/15/2002 23:19'! calculatePortions | arc | portions _ OrderedCollection new. (self adjustValues: values) inject: 0 into: [:sum :each | arc _ ArcMorph new. arc borderWidth: 0. arc width: self width. arc height: self height. arc degreesFrom: sum. arc degreesTo: sum + each. portions add: arc. sum + each]! ]style[(17 3 4 4 8 3 17 8 4 15 6 12 1 10 11 6 3 3 8 9 3 14 1 5 3 8 4 11 3 9 4 12 3 14 3 5 3 12 3 3 4 5 8 6 3 5 3 3 4 1)f1b,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1c202202126,f1,f1cred;,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c202202126,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 7/8/2002 22:19'! colorPortions | colors | colors _ Color cyan wheel: portions size. colors do: [:each | (portions at: (colors indexOf: each)) color: each]! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 6/27/2002 06:12'! defaultDiameter ^ self defaultRadius * 2! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 6/27/2002 06:12'! defaultRadius ^ 50! ! !PieChartMorph methodsFor: 'private' stamp: 'gm 7/10/2002 19:13'! titlePortions | reference portion | 1 to: references size do: [:index | reference _ references at: index. portion _ portions at: index. portion title: reference. ]! ! !PieChartMorph methodsFor: 'accessing' stamp: 'gm 7/9/2002 16:50'! title ^ title! ! !PieChartMorph methodsFor: 'accessing' stamp: 'gm 7/9/2002 16:50'! title: aString title_ aString! ! !PieChartMorph methodsFor: 'change reporting' stamp: 'gm 7/16/2002 07:37'! changed self submorphs do: [:each | each width: self width. each height: self height]. ^ super changed! ! !PieChartMorph class methodsFor: 'instance creation' stamp: 'gm 7/9/2002 15:39'! values: aCollection ^ self new initializeValues: aCollection! ! !SemiArc methodsFor: 'accessing' stamp: 'gm 7/8/2002 19:21'! vertices ^ vertices! ! !SemiArc methodsFor: 'initializing' stamp: 'gm 7/8/2002 19:08'! initialize vertices _ OrderedCollection new.! ! !SemiArc methodsFor: 'initializing' stamp: 'gm 7/16/2002 06:19'! initializeFrom: fromNumber to: toNumber center: aPoint radius: radiusNumber self initialize. radiansFrom _ fromNumber. radiansTo _ toNumber. center _ aPoint. radius _ radiusNumber. self calculateVertices! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/9/2002 15:35'! addIntermediatePoints | arcBeginX arcEndX | arcBeginX _ (radiansFrom cos * radius) rounded. arcEndX _ (radiansTo cos * radius) rounded. arcBeginX = arcEndX ifTrue: [vertices add: (self pointAtX: arcBeginX)] ifFalse:[ arcBeginX to: arcEndX by: (arcEndX - arcBeginX) sign do: [:each | vertices add: (self pointAtX: each)]]! ]style[(21 3 18 4 9 4 11 7 6 12 7 4 9 7 6 41 8 11 4 35 9 7 7 8 7 3 9 14 6 2 8 11 4 11 4 3)f1b,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cred;,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cblue;i,f1! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/8/2002 19:22'! addPointAtFrom vertices add: (self pointAtRadians: radiansFrom). ! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/8/2002 19:47'! addPointAtTo vertices add: (self pointAtRadians: radiansTo)! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/16/2002 06:19'! calculateVertices radiansFrom >= radiansTo ifTrue: [^ self]. radiansFrom < Float pi & (radiansTo > Float pi) ifTrue: [^ self]. self addPointAtFrom. self addIntermediatePoints. self addPointAtTo. self invertIfNeeded. self removeInvalidPoints. self translateToCenter! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/8/2002 19:27'! invertIfNeeded | upSide | upSide _ radiansFrom <= Float pi & (radiansTo <= Float pi). upSide ifTrue: [vertices _ vertices collect: [:each | each x @ each y negated]]. ! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/8/2002 18:48'! pointAtRadians: radians | x y | x _ radius * radians cos. y _ (radius * radians sin) rounded abs. ^ x @ y! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/8/2002 18:47'! pointAtX: x | y | y _ (x * (x / radius) arcCos tan) rounded. ^ x @ y! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/8/2002 19:28'! removeInvalidPoints vertices removeAll: (vertices select: [:each | each x = 0 & (each y = 0)]). ! ! !SemiArc methodsFor: 'private' stamp: 'gm 7/8/2002 19:39'! translateToCenter vertices _ vertices collect: [:each | each translateBy: center x @ center y]! ]style[(17 2 8 3 8 15 6 2 4 34)f1b,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cred;,f1,f1cblue;i,f1! ! !SemiArc class methodsFor: 'instance creation' stamp: 'gm 7/9/2002 15:40'! from: fromNumber to: toNumber center: aPoint radius: radiusNumber ^ self new initializeFrom: fromNumber to: toNumber center: aPoint radius: radiusNumber! ! SemiArc class removeSelector: #from:to:radius:! SemiArc removeSelector: #calculatePolygon! SemiArc removeSelector: #degreesFrom:! SemiArc removeSelector: #degreesTo:! SemiArc removeSelector: #drawOn:! SemiArc removeSelector: #initializeFrom:to:radius:! SemiArc removeSelector: #pointAtRadians:radius:! SemiArc removeSelector: #pointAtX:radius:! SemiArc removeSelector: #polygon! SemiArc removeSelector: #polygonFrom:to:! SemiArc removeSelector: #radiansFrom:! SemiArc removeSelector: #radiansTo:! SemiArc removeSelector: #radius! SemiArc removeSelector: #radius:! !SemiArc reorganize! ('accessing' vertices) ('initializing' initialize initializeFrom:to:center:radius:) ('private' addIntermediatePoints addPointAtFrom addPointAtTo calculateVertices invertIfNeeded pointAtRadians: pointAtX: removeInvalidPoints translateToCenter) ! PieChartMorph removeSelector: #addPiePortionFrom:to:color:! PieChartMorph removeSelector: #addPortions:! PieChartMorph removeSelector: #calculatePortions:! PieChartMorph removeSelector: #colorPortions:! PieChartMorph removeSelector: #defaultCenter! PieChartMorph removeSelector: #defaultSize! PieChartMorph removeSelector: #drawOn:! !PieChartMorph reorganize! ('initialization' initialize initializeValues:) ('private' addPortions adjustValues: balloonText calculatePortions colorPortions defaultDiameter defaultRadius titlePortions) ('accessing' title title:) ('change reporting' changed) ! ArcMorph class removeSelector: #from:to:! ArcMorph removeSelector: #angleFrom:! ArcMorph removeSelector: #angleTo:! ArcMorph removeSelector: #calculatePolygon! ArcMorph removeSelector: #createPolygon! ArcMorph removeSelector: #defaultCenter! ArcMorph removeSelector: #drawOn:onZone:! ArcMorph removeSelector: #initializeFrom:to:! ArcMorph removeSelector: #pointAt:radius:! ArcMorph removeSelector: #pointAtRadians:radius:! ArcMorph removeSelector: #pointAtX:radius:! ArcMorph removeSelector: #polygonFrom:to:! ArcMorph removeSelector: #rectanglesFrom:to:! ArcMorph removeSelector: #setVertices:!