SystemOrganization addCategory: #'OB-Tests-Morphic'! OBBuilderTest subclass: #OBMorphBuilderTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Morphic'! !OBMorphBuilderTest methodsFor: 'accessing' stamp: 'cwp 7/8/2007 01:21'! builderClass ^ OBMorphBuilder! ! !OBMorphBuilderTest methodsFor: 'accessing' stamp: 'cwp 5/20/2007 20:20'! displayStringForChild: aNode ^ aNode displayString! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! tests01BrowserCreatesWindow | morph | morph := self buildWindow. self assert: (morph isKindOf: SystemWindow). self assert: morph model == model! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'cwp 7/21/2007 22:02'! tests02BrowserAddsPanelGroups | widget rectangles | widget := self buildWindow. rectangles := widget submorphs select: [:ea | ea class == OBGroupingMorph]. self assert: rectangles size = 2 ! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! tests02BrowserAddsPanels | morphs | morphs := self buildWindow submorphs gather: [ :ea | ea submorphs ]. morphs := morphs select: [ :ea | ea respondsTo: #model ]. self assert: (morphs anySatisfy: [ :ea | ea model isKindOf: OBColumnPanel ]). self assert: (morphs anySatisfy: [ :ea | ea model isKindOf: OBDefinitionPanel ])! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! tests03ColumnPanelAddsColumns | morph panes | morph := self buildNavigationPanel. panes := morph submorphs first submorphs. self assert: (morph model isKindOf: OBColumnPanel). self assert: panes size = 7. (1 to: 7 by: 2) do: [ :ea | self assert: ((panes at: ea) isKindOf: OBPane) ]! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! tests04ColumnAddsList | morph | morph := self build: self columnWithFilter. self assert: (morph isKindOf: OBPane). self assert: (morph submorphs last isKindOf: PluggableListMorph)! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! tests05ColumnAddsButton | morph | morph := self build: self columnWithFilter. self assert: (morph isKindOf: OBPane). self assert: (morph submorphs first isKindOf: OBRadioButtonBar)! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'cwp 7/21/2007 22:02'! tests06TwoGroupSpecialCase | widget rectangles | widget := self buildWindow. rectangles := widget submorphs select: [:ea | ea class == OBGroupingMorph]. self assert: rectangles size = 2. self assert: (rectangles first layoutFrame bottomFraction = 0.4). self assert: (rectangles second layoutFrame topFraction = 0.4). ! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! tests07ButtonModelCanBeBuiltAlone | morph | model := OBButtonModel withLabel: 'test' inBar: self. morph := OBMorphBuilder build: model. self assert: (morph isKindOf: PluggableButtonMorph)! ! !OBMorphBuilderTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! tests08SwitchCanBeBuiltAlone | morph | morph := self build: self switch. self assert: (morph isKindOf: OBRadioButtonBar)! ! TestCase subclass: #OBButtonBarTest instanceVariableNames: 'bar received' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Morphic'! !OBButtonBarTest class methodsFor: 'instance creation' stamp: 'cwp 3/11/2007 17:03'! openBar self new setUp; openBarInWorld! ! !OBButtonBarTest methodsFor: 'callbacks' stamp: 'lr 11/7/2009 18:32'! cmd1 received := #cmd1! ! !OBButtonBarTest methodsFor: 'callbacks' stamp: 'lr 1/15/2010 09:49'! cmd3 received := #cmd3! ! !OBButtonBarTest methodsFor: 'callbacks' stamp: 'lr 1/15/2010 09:49'! cmd4 received := #cmd4! ! !OBButtonBarTest methodsFor: 'callbacks' stamp: 'cwp 3/11/2007 21:03'! color ^ Color red! ! !OBButtonBarTest methodsFor: 'callbacks' stamp: 'cwp 5/2/2007 23:07'! commands ^ {(OBPluggableCommand action: [self cmd1]) buttonLabel: 'Command 1'. (OBPluggableCommand action: [self cmd3]) buttonLabel: 'Command 3'. (OBPluggableCommand action: [self cmd4]) buttonLabel: 'Command 4'; active: [false]}! ! !OBButtonBarTest methodsFor: 'running' stamp: 'lr 1/22/2010 17:47'! openBarInWorld bar openInWorld. self changed: #commands. bar bounds: (100@100 corner: 500@140) ! ! !OBButtonBarTest methodsFor: 'simulating' stamp: 'lr 11/7/2009 18:32'! push: aString | button | button := bar submorphs detect: [ :b | b label = aString ]. button performAction! ! !OBButtonBarTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp bar := OBButtonBar on: self! ! !OBButtonBarTest methodsFor: 'testing' stamp: 'lr 1/22/2010 17:47'! testLayout | rects | "This is an ugly hack. I can't figure out how else to force a layout." self openBarInWorld. bar delete. rects := bar submorphs collect: [ :b | b bounds ]. self assert: bar left <= rects first left. self assert: rects first right <= rects second left. self assert: rects second right <= rects third left. self assert: rects third right <= bar right! ! !OBButtonBarTest methodsFor: 'testing' stamp: 'cwp 3/11/2007 16:53'! testPush1 self push: 'Command 1'. self assert: received = #cmd1! ! !OBButtonBarTest methodsFor: 'testing' stamp: 'cwp 3/11/2007 17:06'! testPush4 self push: 'Command 4'. self assert: received isNil! ! TestCase subclass: #OBMenuMorphTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Morphic'! !OBMenuMorphTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testAddSubmenu | menu submenu | menu := MenuMorph new. submenu := menu addSubmenu: 'test item' enabled: true. self assert: menu class == submenu class! ! TestCase subclass: #OBPaneLayoutTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Morphic'! !OBPaneLayoutTest methodsFor: 'callbacks' stamp: 'cwp 11/2/2004 00:37'! buttonMorph ^ RectangleMorph new color: Color red; yourself! ! !OBPaneLayoutTest methodsFor: 'callbacks' stamp: 'cwp 5/3/2007 21:08'! dragEnabled ^ false! ! !OBPaneLayoutTest methodsFor: 'callbacks' stamp: 'cwp 5/3/2007 21:08'! dropEnabled ^ false! ! !OBPaneLayoutTest methodsFor: 'emulating' stamp: 'cwp 5/31/2007 21:00'! isActive ^ true! ! !OBPaneLayoutTest methodsFor: 'testing' stamp: 'cwp 7/24/2007 01:05'! isEnabled: aButtonModel ^ true! ! !OBPaneLayoutTest methodsFor: 'callbacks' stamp: 'cwp 5/3/2007 21:11'! list ^ #('a' 'b' 'c')! ! !OBPaneLayoutTest methodsFor: 'callbacks' stamp: 'cwp 11/2/2004 00:34'! listMorph ^ RectangleMorph new ! ! !OBPaneLayoutTest methodsFor: 'emulating' stamp: 'cwp 6/11/2009 15:15'! longDescriptions ^ #()! ! !OBPaneLayoutTest methodsFor: 'callbacks' stamp: 'cwp 5/3/2007 21:07'! selection ^ 0! ! !OBPaneLayoutTest methodsFor: 'testing' stamp: 'lr 9/6/2010 08:59'! testButtonPlacement | pane button builder | builder := OBMorphBuilder new. pane := builder pane: self with: [builder radioButtonBar: self with: []]. pane bounds: (0 @ 0 corner: 200 @ 400). button := pane submorphs at: 1. self assert: button top >= pane top. self assert: button bottom <= pane bottom. self assert: button left >= pane left. self assert: button right <= pane right! ! TestCase subclass: #OBPaneScrollerTest instanceVariableNames: 'paneCount scroller' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Morphic'! !OBPaneScrollerTest methodsFor: 'actions' stamp: 'cwp 3/25/2007 00:30'! buildOn: aBuilder ^ RectangleMorph new bounds: (10@10 corner: 20@20); yourself! ! !OBPaneScrollerTest methodsFor: 'callbacks' stamp: 'cwp 3/25/2007 00:31'! columns ^ ((1 to: paneCount) collect: [:i | self]) asOrderedCollection! ! !OBPaneScrollerTest methodsFor: 'actions' stamp: 'cwp 11/2/2004 00:00'! createPane ^ RectangleMorph new bounds: (10@10 corner: 20@20); yourself! ! !OBPaneScrollerTest methodsFor: 'actions' stamp: 'cwp 11/21/2004 22:40'! createScroller scroller := OBPaneScroller withModel: self. scroller bounds: (10 @ 420 extent: 600 @ 160)! ! !OBPaneScrollerTest methodsFor: 'callbacks' stamp: 'cwp 11/21/2004 12:55'! panes ^ ((1 to: paneCount) collect: [:i | self createPane]) asOrderedCollection! ! !OBPaneScrollerTest methodsFor: 'callbacks' stamp: 'cwp 11/23/2004 01:37'! reclaimPanes ^ scroller panes size - 4! ! !OBPaneScrollerTest methodsFor: 'callbacks' stamp: 'cwp 11/17/2004 23:39'! sizing ^ 4! ! !OBPaneScrollerTest methodsFor: 'tests' stamp: 'cwp 11/21/2004 22:40'! testPaneHeightNoScrollBar paneCount := 4. self createScroller. self assert: scroller paneHeight = 160! ! !OBPaneScrollerTest methodsFor: 'tests' stamp: 'cwp 11/21/2004 22:40'! testPaneHeightWithScrollBar paneCount := 5. self createScroller. self assert: scroller paneHeight = 147! ! !OBPaneScrollerTest methodsFor: 'tests' stamp: 'cwp 5/31/2007 21:10'! testPaneReclamation paneCount := 6. self createScroller. scroller submorphs first setValue: 0.2. paneCount := 4. scroller update: #columns. self assert: scroller panes size = 4! ! !OBPaneScrollerTest methodsFor: 'tests' stamp: 'cwp 11/21/2004 23:11'! testResizeUpdatesPaneHeight paneCount := 4. self createScroller. self assert: scroller panes first height = 160. scroller bounds: (scroller bounds outsetBy: 1). self assert: scroller panes first height = 162! ! !OBPaneScrollerTest methodsFor: 'tests' stamp: 'cwp 7/21/2007 22:04'! testResizeUpdatesPaneWidth | width | paneCount := 4. self createScroller. width := scroller panes first width. scroller bounds: (scroller bounds outsetBy: 2). self assert: width + 1 = scroller panes first width! ! TestCase subclass: #OBRadioButtonBarTest instanceVariableNames: 'bar selection' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Morphic'! !OBRadioButtonBarTest methodsFor: 'asserting' stamp: 'cwp 11/27/2004 18:03'! assertSelectionIs: anInteger self assert: selection = anInteger. bar submorphs withIndexDo: [:button :index | index = anInteger ifTrue: [self assert: button isOn] ifFalse: [self deny: button isOn]]! ! !OBRadioButtonBarTest methodsFor: 'testing' stamp: 'cwp 7/24/2007 01:06'! isEnabled: aButtonModel ^ true! ! !OBRadioButtonBarTest methodsFor: 'callbacks' stamp: 'cwp 2/22/2004 17:42'! list ^ #('alpha' 'beta' 'gamma')! ! !OBRadioButtonBarTest methodsFor: 'emulating' stamp: 'cwp 6/11/2009 15:15'! longDescriptions ^ #()! ! !OBRadioButtonBarTest methodsFor: 'simulating' stamp: 'lr 11/7/2009 18:32'! push: aString | button | button := bar submorphs detect: [ :b | b label contents = aString ]. button performAction! ! !OBRadioButtonBarTest methodsFor: 'callbacks' stamp: 'cwp 2/22/2004 16:39'! selection ^ selection! ! !OBRadioButtonBarTest methodsFor: 'callbacks' stamp: 'lr 11/7/2009 18:32'! selection: anInteger selection := anInteger. self changed: #selection! ! !OBRadioButtonBarTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp selection := 0. bar := OBRadioButtonBar on: self list: #list selected: #selection changeSelected: #selection:! ! !OBRadioButtonBarTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testLayout | rects | "This is an ugly hack. I can't figure out how else to force a layout." bar openInWorld. self changed: #list. bar bounds: (100 @ 100 corner: 400 @ 140). bar delete. rects := bar submorphs collect: [ :b | b bounds ]. self assert: rects first left >= bar left. self assert: rects first right <= rects second left. self assert: rects second right <= rects third left. self assert: rects third right <= bar right! ! !OBRadioButtonBarTest methodsFor: 'testing' stamp: 'cwp 2/22/2004 16:53'! testList self assert: bar list = self list! ! !OBRadioButtonBarTest methodsFor: 'testing' stamp: 'cwp 2/24/2004 19:35'! testPushAlphaBeta self changed: #list. self push: 'alpha'. self assertSelectionIs: 1. self push: 'beta'. self assertSelectionIs: 2.! ! !OBRadioButtonBarTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testUpdateList | labels | self changed: #list. labels := bar submorphs collect: [ :b | b label contents ]. self assert: labels size = self list size. self assert: (labels includesAllOf: self list)! ! !OBRadioButtonBarTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testUpdateSelection self changed: #list. selection := 2. self changed: #selection. self assertSelectionIs: 2! !