The Trunk: MorphicExtras-topa.176.mcz

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@i to: aCanvas clipRect width@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]. !