[squeak-dev] The Trunk: MorphicExtras-topa.176.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jun 14 09:30:22 UTC 2016


Tobias Pape uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-topa.176.mcz

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

Name: MorphicExtras-topa.176
Author: topa
Time: 14 June 2016, 11:30:05.074834 am
UUID: b32dc615-496b-4767-8ea0-3b3e8af40fc5
Ancestors: MorphicExtras-pre.175

Add a HistogramMorph similar to GraphMorph

=============== Diff against MorphicExtras-pre.175 ===============

Item was added:
+ RectangleMorph subclass: #HistogramMorph
+ 	instanceVariableNames: 'bag cachedForm values counts max sum limit labelBlock countLabelBlock'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'MorphicExtras-Widgets'!
+ 
+ !HistogramMorph commentStamp: 'topa 6/14/2016 11:27' prior: 0!
+ I display bags as a histogram, that is a bar chart of the counts in the bag.
+ 
+ Example:
+ 	HistogramMorph openOn: (Smalltalk allClasses gather: 
+ 		[:class | class selectors collect: [:selector | class ]])
+ 
+ 
+ Instance Variables
+ 	bag:		<Bag>
+ 	cachedForm:		<Form>
+ 	countLabelBlock:		<BlockClosure>
+ 	counts:		<SequencableCollection>
+ 	labelBlock:		<BlockClosure>
+ 	limit:		<Number>
+ 	max:		<Number>
+ 	sum:		<Number>
+ 	values:		<SequencableCollection>
+ 
+ bag
+ 	- The bag that forms the data basis for the histogram display
+ 
+ cachedForm
+ 	- A form used to cache the historgram rendering.
+ 
+ countLabelBlock
+ 	- Optional. Block that receives the count for the current bar and should return a String.
+ 	  Leaving this nil is equivalent to [:count | count asString].
+ 
+ counts
+ 	- Cached collection of all counts in (value-)frequency-sorted order for rendering speed.
+ 	See values.
+ 
+ labelBlock
+ 	- Optional. Block that receives the value for the current bar and should return a 
+ 	String for the label. Leaving this nil is equivalent to [:value | value asString].
+ 
+ limit
+ 	- Maximum number of elements from values to consider. Defaults to 25.
+ 
+ max
+ 	- Cached maximum value from values. 
+ 
+ sum
+ 	- Cached sum of all elements in values. Determines overall histogram height.
+ 
+ values
+ 	- Cached collection of all values in frequency-sorted order for rendering speed.
+ 	See counts.!

Item was added:
+ ----- Method: HistogramMorph class>>on: (in category 'instance creation') -----
+ on: aCollection
+ 
+ 	^ self new
+ 		bag: aCollection asBag;
+ 		yourself!

Item was added:
+ ----- Method: HistogramMorph class>>openOn: (in category 'instance creation') -----
+ openOn: aCollection
+ 
+ 	^ (self on: aCollection)
+ 		openInHand!

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

Item was added:
+ ----- Method: HistogramMorph>>bag: (in category 'accessing') -----
+ bag: anObject
+ 
+ 	self basicBag: anObject.
+ 	self flush.
+ 	self changed.
+ !

Item was added:
+ ----- Method: HistogramMorph>>basicBag: (in category 'accessing') -----
+ basicBag: anObject
+ 
+ 	bag := anObject.!

Item was added:
+ ----- Method: HistogramMorph>>basicLimit: (in category 'accessing') -----
+ basicLimit: anObject
+ 
+ 	limit := anObject.
+ !

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

Item was added:
+ ----- Method: HistogramMorph>>cachedForm: (in category 'accessing') -----
+ cachedForm: anObject
+ 
+ 	cachedForm := anObject.!

Item was added:
+ ----- Method: HistogramMorph>>color: (in category 'accessing') -----
+ color: aColor
+ 
+ 	super color: aColor.
+ 	self flushCachedForm.
+ !

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

Item was added:
+ ----- Method: HistogramMorph>>countLabelBlock: (in category 'accessing') -----
+ countLabelBlock: anObject
+ 
+ 	countLabelBlock := anObject.!

Item was added:
+ ----- Method: HistogramMorph>>countLabelFor: (in category 'drawing') -----
+ countLabelFor: aNumber
+ 
+ 	^ self countLabelBlock 
+ 		ifNotNil: [:block | block value: aNumber]
+ 		ifNil: [aNumber asString]
+ !

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

Item was added:
+ ----- Method: HistogramMorph>>counts: (in category 'accessing') -----
+ counts: anObject
+ 
+ 	counts := anObject.!

Item was added:
+ ----- Method: HistogramMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	^ Color veryVeryLightGray!

Item was added:
+ ----- Method: HistogramMorph>>drawBar:value:count:chartHeight:font:on: (in category 'drawing') -----
+ drawBar: aRectangle value: anObject count: anInteger chartHeight: chartHeight font: aFont on: aCanvas
+ 
+ 	| label countLabel labelWidth countWidth midX  |
+ 	label := self labelFor: anObject.
+ 	countLabel := self countLabelFor: anInteger.
+ 	labelWidth := aFont widthOfString: label.
+ 	countWidth := aFont widthOfString: countLabel.
+ 	midX := aRectangle origin x + (aRectangle width // 2).
+ 	
+ 	aCanvas fillRectangle: aRectangle color: Color blue.
+ 	self drawLabel: label width: labelWidth at: (midX - (labelWidth // 2) @ chartHeight) barWidth: aRectangle width font: aFont on: aCanvas.
+ 	countWidth < aRectangle width
+ 		ifTrue: [aCanvas drawString: countLabel at: (midX - (countWidth // 2) @ (chartHeight - (3/2 * aFont height))) font: aFont color: Color lightGray].
+ !

Item was added:
+ ----- Method: HistogramMorph>>drawDataOn: (in category 'drawing') -----
+ drawDataOn: aCanvas
+ 
+ 	| numX elementWidth offsetX font fontHeight offsetY maxY barWidth barRadius chartHeight |
+ 	font := TextStyle defaultFont.
+ 	fontHeight := font height.
+ 	numX := self limit.
+ 	maxY := self sum.
+ 	elementWidth := self width / (numX + 1).
+ 	barWidth := 2 max: (elementWidth * 0.9) floor.
+ 	barRadius := barWidth / 2.
+ 	offsetX := elementWidth / 2.
+ 	offsetY := fontHeight * 1.2
+ 		max: (self values collect: [:value | font widthOfString: (self labelFor: value)]) max.
+ 	chartHeight := self height - offsetY.
+ 
+ 	0 to: (self height - offsetY) by: 20 do: [:i |
+ 	aCanvas
+ 		line: 0 at i to: aCanvas clipRect width at i width: 1 color: (Color lightGray lighter alpha: 0.5)].
+ 	
+ 	self valuesAndCountsWithIndexDo: 
+ 		[:value :count :barIndex | | barMidX origin end  |
+ 		barIndex <= self limit ifTrue: [
+ 			barMidX := barIndex * elementWidth.
+ 			origin := barMidX - barRadius @ ((maxY - count) / maxY * chartHeight).
+ 			end := barMidX + barRadius @ chartHeight.
+ 
+ 			self
+ 				drawBar: (origin corner: end)  
+ 				value: value
+ 				count: count
+ 				chartHeight: chartHeight
+ 				font: font
+ 				on: aCanvas]].
+ !

Item was added:
+ ----- Method: HistogramMorph>>drawLabel:width:at:barWidth:font:on: (in category 'drawing') -----
+ drawLabel: aString width: aNumber at: aPoint barWidth: barWidth font: aFont on: aCanvas
+ 
+ 	aNumber <= barWidth
+ 		ifTrue: [aCanvas drawString: aString at: aPoint font: aFont color: Color black]
+ 		ifFalse: [
+ 			| c  |
+ 			c := Display defaultCanvasClass extent: aNumber @ aFont height.
+ 			c drawString: aString at: 0 @ 0  font: aFont color: Color black.
+ 			aCanvas paintImage: (c form rotateBy: -90 smoothing: 3) at: aPoint].!

Item was added:
+ ----- Method: HistogramMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas 
+ 	| c |
+ 	self cachedForm 
+ 		ifNil:
+ 			[c := Display defaultCanvasClass extent: self bounds extent.
+ 			c translateBy: self bounds origin negated
+ 				during: [:tempCanvas | super drawOn: tempCanvas].
+ 			self drawDataOn: c.
+ 			self cachedForm: c form].
+ 	aCanvas 
+ 		cache: self bounds
+ 		using: self cachedForm
+ 		during: [:cachingCanvas | self drawDataOn: cachingCanvas].
+ !

Item was added:
+ ----- Method: HistogramMorph>>flush (in category 'initialization') -----
+ flush
+ 
+ 	| valuesAndCounts |
+ 	self bag ifNil: [^self]. "nothing to do yet"
+ 	valuesAndCounts := self bag sortedCounts.
+ 	valuesAndCounts size < self limit
+ 		ifTrue: [self basicLimit: valuesAndCounts size].
+ 	self values: ((valuesAndCounts collect: [:ea | ea value]) first: self limit).
+ 	self counts: ((valuesAndCounts collect: [:ea | ea key]) first: self limit).
+ 	self max: self counts max.
+ 	self sum: self counts sum.
+ 
+ 	self flushCachedForm.
+ !

Item was added:
+ ----- Method: HistogramMorph>>flushCachedForm (in category 'initialization') -----
+ flushCachedForm
+ 
+ 	cachedForm := nil.
+ !

Item was added:
+ ----- Method: HistogramMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self
+ 		extent:  700 @ 400;
+ 		basicLimit: 25;
+ 		yourself.!

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

Item was added:
+ ----- Method: HistogramMorph>>labelBlock: (in category 'accessing') -----
+ labelBlock: anObject
+ 
+ 	labelBlock := anObject.!

Item was added:
+ ----- Method: HistogramMorph>>labelFor: (in category 'drawing') -----
+ labelFor: aValue
+ 
+ 	^ self labelBlock 
+ 		ifNotNil: [:block | block value: aValue]
+ 		ifNil: [aValue asString]
+ !

Item was added:
+ ----- Method: HistogramMorph>>layoutChanged (in category 'layout') -----
+ layoutChanged
+ 
+ 	super layoutChanged.
+ 	cachedForm := nil.
+ !

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

Item was added:
+ ----- Method: HistogramMorph>>limit: (in category 'accessing') -----
+ limit: anObject
+ 
+ 	self basicLimit: anObject.
+ 	self flush.
+ 	self changed!

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

Item was added:
+ ----- Method: HistogramMorph>>max: (in category 'accessing') -----
+ max: anObject
+ 
+ 	max := anObject.!

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

Item was added:
+ ----- Method: HistogramMorph>>sum: (in category 'accessing') -----
+ sum: anObject
+ 
+ 	sum := anObject!

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

Item was added:
+ ----- Method: HistogramMorph>>values: (in category 'accessing') -----
+ values: anObject
+ 
+ 	values := anObject.!

Item was added:
+ ----- Method: HistogramMorph>>valuesAndCountsWithIndexDo: (in category 'enumeration') -----
+ valuesAndCountsWithIndexDo: aBlock
+ 
+ 	1 to: self values size do: [:index |
+ 		aBlock
+ 			value: (self values at: index)
+ 			value: (self counts at: index)
+ 			value: index].	!



More information about the Squeak-dev mailing list