--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CompactHierarchicalItem.st Fri May 01 16:40:04 2015 +0200
@@ -0,0 +1,290 @@
+"{ Encoding: utf8 }"
+
+"
+ COPYRIGHT (c) 1999 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libwidg2' }"
+
+"{ NameSpace: Smalltalk }"
+
+AbstractHierarchicalItem subclass:#CompactHierarchicalItem
+ instanceVariableNames:'widthAndHeight model'
+ classVariableNames:'MaskHeight MaskWidth ShiftHeight ShiftWidth'
+ poolDictionaries:''
+ category:'Views-Support'
+!
+
+CompactHierarchicalItem subclass:#CompactHierarchicalItemExpanded
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:CompactHierarchicalItem
+!
+
+Object subclass:#Geometry
+ instanceVariableNames:'width height'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:CompactHierarchicalItem
+!
+
+!CompactHierarchicalItem class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1999 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+!
+
+documentation
+"
+ Compact Hierarchical Items are a new, tuned and optimized version of the original
+ hierarchical item, which suffers various problems:
+ 1) the old item did not store the model, which in many situations leads to very
+ poor performance (it walks along the super-item hierarchy to find the model,
+ which makes many algorithms O(n^2) instead of O(n)
+ 2) it keeps individual width/height information, where this could be shared if
+ many items have the same extent.
+ 3) it uses separate width/height instvars, where this information can be stored more compact
+ in single integer (using bit-masks)
+ 4) it uses a separate boolean for the isExpanded, which can be encoded as a single bit
+
+ This class solves those issues:
+ - it uses a compact width/height representation (bit masks in an integer), for
+ items within a reasonable size (up to 64k pixels wide, up to 16k pixels high).
+ - falls back to a separate width/height holding object, if ever exceeded (which is unlikely)
+
+ - it encodes the expanded state in the class itself (changing as appropriate)
+
+ - it uses the saved slot to allow for the model to be kept locally
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ HierarchicalItem
+"
+! !
+
+!CompactHierarchicalItem class methodsFor:'class initialization'!
+
+initialize
+ ShiftWidth := 0.
+ MaskWidth := 16rFFFF.
+ ShiftHeight := MaskWidth highBit.
+ MaskHeight := 16r1FFF.
+ "/ self assert:(ShiftHeight + (MaskHeight highBit)) < 31.
+! !
+
+!CompactHierarchicalItem methodsFor:'accessing-mvc'!
+
+fetchModel
+ "returns the hierachicalList model or nil.
+ This is a stupid implementation here, in that the top-item's parent is assumed to
+ be the model of the tree, and that is returned.
+ This saves a slot in every node, but makes some algorithms O(n*log n) or even O(n^2).
+ So be aware of the performance penalty"
+
+ |item next|
+
+ item := self.
+ [ (next := item parentOrModel) notNil ] whileTrue:[
+ item := next.
+ ].
+
+ item isHierarchicalItem ifFalse:[^ item].
+ ^ nil
+!
+
+model
+ "returns the hierachicalList model or nil.
+ This fixes the stupid implementation of the old HierarchicalItem,
+ by caching the fetched model (behaving the same, if there is no model)"
+
+ model isNil ifTrue:[
+ model := self fetchModel.
+ model isNil ifTrue:[
+ model := #nilModel.
+ ^ nil
+ ].
+ ].
+ model == #nilModel ifTrue:[
+ ^ nil
+ ].
+ ^ model
+! !
+
+!CompactHierarchicalItem methodsFor:'private'!
+
+classToUseWhenCollapsed
+ "must be redefined when subclassed"
+
+ self class == CompactHierarchicalItemExpanded ifFalse:[
+ self subclassResponsibility:'this method must be redefined when subclassed'
+ ].
+ ^ CompactHierarchicalItem
+!
+
+classToUseWhenExpanded
+ "must be redefined when subclassed"
+
+ self class == CompactHierarchicalItem ifFalse:[
+ self subclassResponsibility:'this method must be redefined when subclassed'
+ ].
+ ^ CompactHierarchicalItemExpanded
+!
+
+heightIsUnknown
+ ^ widthAndHeight isNil
+ or:[ widthAndHeight isInteger not
+ and:[ widthAndHeight height isNil ]]
+!
+
+makeWidthAndHeightUnknown
+ "invalidate any cached with/height information"
+
+ "see comments in widthOn/heightOn"
+ widthAndHeight := nil
+!
+
+setExpanded:aBoolean
+ "set expanded flag without any computation or notification"
+
+ |newClass|
+
+ self isExpanded ~~ aBoolean ifTrue:[
+ newClass := aBoolean
+ ifTrue:[self classToUseWhenExpanded]
+ ifFalse:[self classToUseWhenCollapsed].
+ self changeClassTo:newClass
+ ]
+!
+
+widthIsUnknown
+ ^ widthAndHeight isNil
+ or:[ widthAndHeight isInteger not
+ and:[ widthAndHeight width isNil ]]
+! !
+
+!CompactHierarchicalItem methodsFor:'protocol-displaying'!
+
+getWidthAndHeightOn:aGC
+ "fetch the width and height from my label, if it is to be displayed on aGC"
+
+ |lbl|
+
+ lbl := self label.
+ self width:(self widthOf:lbl on:aGC) height:(self heightOf:lbl on:aGC)
+!
+
+heightOn:aGC
+ "return the width of the receiver, if it is to be displayed on aGC"
+
+ widthAndHeight isNil ifTrue:[
+ self getWidthAndHeightOn:aGC.
+ ].
+ widthAndHeight isInteger ifTrue:[
+ ^ (widthAndHeight rightShift:ShiftHeight) bitAnd:MaskHeight
+ ].
+ ^ widthAndHeight height
+!
+
+width:w height:h
+ ((w between:0 and:MaskWidth)
+ and:[ (h between:0 and:MaskHeight) ]) ifTrue:[
+ widthAndHeight := (w bitShift:ShiftWidth) bitOr:(h bitShift:ShiftHeight)
+ ] ifFalse:[
+ widthAndHeight := Geometry new width:w height:h
+ ].
+!
+
+widthOn:aGC
+ "return the width of the receiver, if it is to be displayed on aGC"
+
+ widthAndHeight isNil ifTrue:[
+ self getWidthAndHeightOn:aGC.
+ ].
+ widthAndHeight isInteger ifTrue:[
+ ^ (widthAndHeight rightShift:ShiftWidth) bitAnd:MaskWidth
+ ].
+ ^ widthAndHeight width
+! !
+
+!CompactHierarchicalItem methodsFor:'queries'!
+
+isExpanded
+ "returns true if the item is expanded"
+
+ "see my ghost-class CompactHierarchicalItemExpanded for the other case"
+ ^ false
+! !
+
+!CompactHierarchicalItem::CompactHierarchicalItemExpanded methodsFor:'queries'!
+
+isExpanded
+ "returns true if the item is expanded"
+
+ ^ true
+! !
+
+!CompactHierarchicalItem::Geometry class methodsFor:'documentation'!
+
+documentation
+"
+ instances are only used if any of width/height is too large to fit into the
+ compact integer bitmasked representation
+"
+! !
+
+!CompactHierarchicalItem::Geometry methodsFor:'accessing'!
+
+height
+ ^ height
+!
+
+height:something
+ height := something.
+!
+
+width
+ ^ width
+!
+
+width:something
+ width := something.
+!
+
+width:widthArg height:heightArg
+ width := widthArg.
+ height := heightArg.
+! !
+
+!CompactHierarchicalItem class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/CompactHierarchicalItem.st,v 1.1 2015-05-01 14:40:04 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libwidg2/CompactHierarchicalItem.st,v 1.1 2015-05-01 14:40:04 cg Exp $'
+! !
+
+
+CompactHierarchicalItem initialize!