'From Squeak3.8alpha of ''17 July 2004'' [latest update: #5987] on 17 September 2004 at 11:32:10 am'! "Change Set: PTabBarMorph-klc-1 Date: 17 September 2004 Author: Ken Causey This is a basic tab bar and tab button morph set. It has been used in BFAV2."! Morph subclass: #PluggableTabBarMorph instanceVariableNames: 'target tabs activeTab' classVariableNames: '' poolDictionaries: '' category: 'PTabBarMorph'! !PluggableTabBarMorph commentStamp: 'KLC 9/17/2004 11:26' prior: 0! This morph manages a set of PluggableTabButtonMorphs. Each tab should be added in the left to right order that they should be displayed. Each tab will be evenly sized to fit the available space. This morph intercepts mouse clicks, figures out which tab was clicked, pops up the new tab as the active tab and triggers the registered event. See PluggableTabButtonMorph for information on what a tab can consist of. Example: (PluggableTabBarMorph on: nil) addTab: (Text fromString: 'Test') withAction: [Transcript show: 'Test'; cr]; addTab: (Text fromString: 'Another') withAction: [Transcript show: 'Another'; cr]; width: 200; openInHand ! Morph subclass: #PluggableTabButtonMorph instanceVariableNames: 'active model textSelector arcLengths subMorph' classVariableNames: '' poolDictionaries: '' category: 'PTabBarMorph'! !PluggableTabButtonMorph commentStamp: 'KLC 9/17/2004 11:27' prior: 0! This is a specialized pluggable button morph that is meant to represent a tab in a set of tabs arranged horizontally. Each tab will overlap slightly when drawn. All but one tab will be drawn in left to right order in the specified color, but lighter. The active tab will be drawn last in the full color and slightly taller to indicate that it is selected. Clicking the active tab has no effect but clicking any other tab will change the active tab to the clicked tab. This morph does not itself accept any events. The parent tab set will grab the mouse clicks and handle notifying the appropriate tabs that they have been activated or deactivated. There is a single selector which provides the text for the button label and affects the width of the tab. When the width changes the tab will inform its parent that it has changed and that the layout needs to be updated. The model for the text selector of course should be the client for the tab set. The button label can be a String, Text, or Morph. Texts work better than plain Strings.! !PluggableTabBarMorph methodsFor: 'actions' stamp: 'KLC 2/2/2004 16:22'! handlesMouseDown: anEvent ^ true! ! !PluggableTabBarMorph methodsFor: 'actions' stamp: 'KLC 2/2/2004 17:49'! layoutChanged "Fix up our tabs bounds" | tabsCount | super layoutChanged. tabsCount _ self tabs size. tabsCount isZero ifFalse: [ | tabInnerExtent count | tabInnerExtent _ ((self width - ((self tabs first key outerGap + self tabs last key outerGap) // 2) - tabsCount) // tabsCount) @ (self height). count _ 1. self tabs do: [ :anAssociation | | tab | tab _ anAssociation key. tab innerExtent: tabInnerExtent. count = 1 ifTrue: [tab position: self position] ifFalse: [ tab position: (self position translateBy: ((tabInnerExtent x + 1) * (count - 1))@0)]. count _ count + 1 ] ]. self changed.! ! !PluggableTabBarMorph methodsFor: 'actions' stamp: 'KLC 2/24/2004 15:14'! mouseDown: anEvent | xPosition newTab | xPosition _ anEvent cursorPoint x. newTab _ ((self tabs detect: [ :anAssociation | | tabBounds | tabBounds _ anAssociation key bounds. (tabBounds left <= xPosition) and: [ tabBounds right >= xPosition]] ifNone: [nil]) key). newTab ifNil: [^ self]. newTab = activeTab ifFalse: [ self activeTab: newTab ] ! ! !PluggableTabBarMorph methodsFor: 'actions' stamp: 'tlk 7/17/2004 14:35'! performActiveTabAction "Look up the Symbol or Block associated with the currently active tab, and perform it." | tabActionAssoc aSymbolOrBlock | tabActionAssoc _ self tabs detect: [ :assoc | assoc key = self activeTab.] ifNone: [ Association new ]. aSymbolOrBlock _ tabActionAssoc value. aSymbolOrBlock ifNil: [ ^ false ]. ^ aSymbolOrBlock isSymbol ifTrue: [ self target perform: aSymbolOrBlock ] ifFalse: [ aSymbolOrBlock value ]. ! ! !PluggableTabBarMorph methodsFor: 'private - access' stamp: 'KLC 2/2/2004 14:17'! activeTab activeTab ifNil: [ self tabs size > 0 ifTrue: [ activeTab _ self tabs first key. activeTab active: true]]. ^ activeTab ! ! !PluggableTabBarMorph methodsFor: 'private - access' stamp: 'KLC 2/24/2004 15:27'! activeTab: aTabMorph self activeTab ifNotNil: [self activeTab toggle]. activeTab _ aTabMorph. self activeTab toggle. aTabMorph delete. self addMorphFront: aTabMorph. self performActiveTabAction. self changed. ! ! !PluggableTabBarMorph methodsFor: 'private - access' stamp: 'KLC 2/2/2004 13:25'! tabs tabs ifNil: [ tabs _ OrderedCollection new ]. ^ tabs! ! !PluggableTabBarMorph methodsFor: 'private - access' stamp: 'KLC 2/2/2004 10:37'! target ^ target! ! !PluggableTabBarMorph methodsFor: 'access' stamp: 'KLC 2/24/2004 15:26'! addTab: aStringOrTextOrMorph withAction: aSymbolOrBlock "Add a new tab. The tab will be added onto the end of the list and displayed on the far right of previously added tabs. The first argument can be a simple String, a Text, or any Morph. The second argument is the action to be performed when the tab is selected. It can either be a symbol for a unary method on the target object or a block. Each tab is stored as an Association with the created tab as the key and the selector as the value." | tabMorph | tabMorph _ PluggableTabButtonMorph on: nil label: [ aStringOrTextOrMorph]. tabMorph color: self color. self addMorphBack: tabMorph. self tabs ifEmpty: [ self activeTab: tabMorph ]. self tabs add: (Association key: tabMorph value: aSymbolOrBlock). self layoutChanged. self changed.! ! !PluggableTabBarMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 17:36'! color: aFillStyle color _ aFillStyle. self tabs do: [ :anAssociation | anAssociation key color: aFillStyle ] ! ! !PluggableTabBarMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 10:37'! target: anObject target _ anObject! ! !PluggableTabBarMorph methodsFor: 'drawing' stamp: 'KLC 2/24/2004 15:10'! drawOn: aCanvas self tabs size > 0 ifFalse: [^ self ]. self tabs do: [ :anAssociation | | tab | tab _ anAssociation key. tab drawOn: aCanvas]! ! !PluggableTabBarMorph class methodsFor: 'instance creation' stamp: 'KLC 2/2/2004 10:38'! on: anObject ^ super new target: anObject! ! !PluggableTabButtonMorph methodsFor: 'drawing' stamp: 'KLC 1/23/2004 15:49'! drawOn: aCanvas self drawTabOn: aCanvas. self drawSubMorphOn: aCanvas! ! !PluggableTabButtonMorph methodsFor: 'drawing' stamp: 'KLC 9/17/2004 11:24'! drawSubMorphOn: aCanvas | morphBounds | morphBounds _ self bounds insetBy: (self cornerRadius + 3) @ (self topInactiveGap // 2 + 2). morphBounds _ morphBounds translateBy: 0@(self topInactiveGap // 2 + 1). self active ifTrue: [ morphBounds _ morphBounds translateBy: 0@((self topInactiveGap // 2 + 1) negated)]. self subMorph bounds height < (morphBounds height) ifTrue: [ morphBounds _ morphBounds insetBy: 0@((morphBounds height - self subMorph bounds height) // 2)]. self subMorph bounds width < (morphBounds width) ifTrue: [ morphBounds _ morphBounds insetBy: ((morphBounds width - self subMorph bounds width) // 2)@0]. self subMorph bounds: morphBounds. aCanvas drawMorph: self subMorph! ! !PluggableTabButtonMorph methodsFor: 'drawing' stamp: 'KLC 2/2/2004 15:07'! drawTabOn: aCanvas | top myColor cornerRadius myArcLengths myBounds | cornerRadius _ self cornerRadius. myBounds _ self bounds. self active ifTrue: [ top _ myBounds top. myColor _ self color ] ifFalse: [ top _ myBounds top + self topInactiveGap. myColor _ self color whiter whiter ]. aCanvas fillRectangle: ((myBounds left + cornerRadius) @ (top + cornerRadius) corner: (myBounds right - cornerRadius) @ self bottom) color: myColor. aCanvas fillRectangle: ((myBounds left + (cornerRadius * 2)) @ top corner: (myBounds right - (cornerRadius * 2)) @ (top + cornerRadius)) color: myColor. aCanvas fillOval: ((myBounds left + self cornerRadius) @ top corner: (myBounds left + (self cornerRadius * 3)) @ (top + (self cornerRadius * 2))) color: myColor. aCanvas fillOval: ((myBounds right - (self cornerRadius * 3)) @ top corner: (myBounds right - self cornerRadius) @ (top + (self cornerRadius * 2))) color: myColor. myArcLengths _ self arcLengths. 1 to: myArcLengths size do: [ :i | | length | length _ myArcLengths at: i. aCanvas line: (myBounds left + cornerRadius - i) @ (myBounds bottom - 1 ) to: (myBounds left + cornerRadius - i) @ (myBounds bottom - length - 1) color: myColor. aCanvas line: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - 1) to: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - length - 1) color: myColor] ! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:25'! active active ifNil: [ active _ false ]. ^ active! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:26'! active: aBoolean active _ aBoolean. self changed.! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 14:05'! innerExtent: aPoint "Set the extent based on the primary visible part of the tab. In other words add twice the cornerRadius to this extent" self extent: (aPoint x + (self cornerRadius * 2)) @ (aPoint y)! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'! model ^ model ! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'! model: anObject model _ anObject! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 2/2/2004 14:07'! outerGap "The horizontal distance of the outer left and right edges of the tab excluding the inner visible part" ^ self cornerRadius * 2! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'! textSelector ^ textSelector ! ! !PluggableTabButtonMorph methodsFor: 'access' stamp: 'KLC 1/22/2004 14:39'! textSelector: aSymbol textSelector _ aSymbol! ! !PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 14:36'! arcLengths arcLengths ifNil: [ self calculateArcLengths ]. ^ arcLengths! ! !PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 14:37'! arcLengths: anArrayOfIntegers arcLengths _ anArrayOfIntegers ! ! !PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 11:30'! cornerRadius ^ 5 ! ! !PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 16:40'! subMorph subMorph ifNil: [ self update: self textSelector ]. ^ subMorph! ! !PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 16:40'! subMorph: aMorph subMorph _ aMorph ! ! !PluggableTabButtonMorph methodsFor: 'private - access' stamp: 'KLC 1/23/2004 11:30'! topInactiveGap ^ 5! ! !PluggableTabButtonMorph methodsFor: 'precalculations' stamp: 'KLC 1/23/2004 14:46'! calculateArcLengths | array radius | radius _ self cornerRadius. array _ Array new: radius. 1 to: radius do: [ :i | | x | x _ i - 0.5. array at: i put: (radius - ((2 * x * radius) - (x * x)) sqrt) asInteger]. self arcLengths: array! ! !PluggableTabButtonMorph methodsFor: 'stepping' stamp: 'KLC 2/2/2004 10:15'! step self subMorph step. self changed. ! ! !PluggableTabButtonMorph methodsFor: 'stepping' stamp: 'KLC 1/23/2004 17:31'! stepTime ^ self subMorph stepTime ! ! !PluggableTabButtonMorph methodsFor: 'stepping' stamp: 'KLC 1/23/2004 17:31'! wantsSteps ^ self subMorph wantsSteps! ! !PluggableTabButtonMorph methodsFor: 'updating' stamp: 'KLC 1/23/2004 17:02'! update: aSelector self textSelector ifNotNil: [ aSelector = self textSelector ifTrue: [ | morph | (aSelector isSymbol and: [model notNil]) ifTrue: [ morph _ (self model perform: aSelector) asMorph] ifFalse: [ morph _ aSelector value asMorph]. self subMorph: morph]]. self changed! ! !PluggableTabButtonMorph methodsFor: 'initialization' stamp: 'KLC 1/22/2004 16:45'! initialize ^ super initialize ! ! !PluggableTabButtonMorph methodsFor: 'actions' stamp: 'KLC 1/23/2004 15:38'! toggle self active: self active not! ! !PluggableTabButtonMorph class methodsFor: 'instance creation' stamp: 'KLC 1/22/2004 14:46'! on: anObject label: getTextSelector | instance | instance _ super new. instance model: anObject. instance textSelector: getTextSelector. ^ instance ! !