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: #OBKeyBindingsTest instanceVariableNames: 'ptm message' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Morphic'! !OBKeyBindingsTest methodsFor: 'asserting' stamp: 'cwp 10/31/2004 00:36'! assert: evt sends: aSelector ptm keyStroke: evt. self assert: message notNil. self assert: message selector = aSelector. self assert: message arguments size = 1. self assert: message arguments first = #OBBrowser.! ! !OBKeyBindingsTest methodsFor: 'callbacks' stamp: 'lr 11/7/2009 18:32'! browseIt: aSelector message := self thisMessage. ^ true! ! !OBKeyBindingsTest methodsFor: 'callbacks' stamp: 'lr 11/7/2009 18:32'! implementorsOfIt: aSelector message := self thisMessage. ^ true! ! !OBKeyBindingsTest methodsFor: 'keystrokes' stamp: 'cwp 10/31/2004 01:08'! ksCmdB ^ self modifier: 64 keycode: 98! ! !OBKeyBindingsTest methodsFor: 'keystrokes' stamp: 'cwp 10/31/2004 01:08'! ksCmdM ^ self modifier: 64 keycode: 109! ! !OBKeyBindingsTest methodsFor: 'keystrokes' stamp: 'cwp 10/31/2004 01:08'! ksCmdN ^ self modifier: 64 keycode: 110! ! !OBKeyBindingsTest methodsFor: 'keystrokes' stamp: 'cwp 10/31/2004 01:09'! ksCmdShiftE ^ self modifier: 72 keycode: 69 ! ! !OBKeyBindingsTest methodsFor: 'keystrokes' stamp: 'cwp 10/31/2004 01:09'! ksCmdShiftN ^ self modifier: 72 keycode: 78! ! !OBKeyBindingsTest methodsFor: 'keystrokes' stamp: 'cwp 10/31/2004 01:09'! ksCmdShiftW ^ self modifier: 72 keycode: 87! ! !OBKeyBindingsTest methodsFor: 'keystrokes' stamp: 'lr 1/27/2010 22:17'! modifier: mod keycode: code ^ KeyboardEvent new setType: 'keystroke' buttons: mod position: 123 @ 456 keyValue: code charCode: code hand: nil stamp: nil; scanCode: 0; "<-- this is required on windows" yourself! ! !OBKeyBindingsTest methodsFor: 'callbacks' stamp: 'cwp 10/31/2004 00:49'! referencesToIt: aSelector message := self thisMessage. ^ true! ! !OBKeyBindingsTest methodsFor: 'callbacks' stamp: 'cwp 10/30/2004 23:26'! selection ^ 1 to: 9! ! !OBKeyBindingsTest methodsFor: 'callbacks' stamp: 'cwp 10/31/2004 00:25'! sendersOfIt: aSelector message := self thisMessage. ^ true! ! !OBKeyBindingsTest methodsFor: 'running' stamp: 'cwp 10/30/2004 22:05'! setUp ptm := (OBPluggableTextMorph on: self text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:) font: Preferences standardCodeFont; yourself! ! !OBKeyBindingsTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 00:33'! testBrowseIt self assert: self ksCmdB sends: #browseIt:! ! !OBKeyBindingsTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 00:35'! testImplementorsOfIt self assert: self ksCmdM sends: #implementorsOfIt:! ! !OBKeyBindingsTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 00:44'! testReferencesToIt self assert: self ksCmdShiftN sends: #referencesToIt:! ! !OBKeyBindingsTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 00:35'! testSendersOfIt self assert: self ksCmdN sends: #sendersOfIt:! ! !OBKeyBindingsTest methodsFor: 'callbacks' stamp: 'cwp 10/30/2004 23:26'! text ^ 'OBBrowser'! ! !OBKeyBindingsTest methodsFor: 'callbacks' stamp: 'cwp 10/30/2004 23:57'! thisMessage | context args | context := thisContext sender. args := Array new: context size. 1 to: args size do: [:i | args at: i put: (context at: 1)]. ^ Message selector: context method selector arguments: args ! ! 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 11/7/2009 19:24'! 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 = (400 - OBPane new defaultButtonHeight asInteger). self assert: button bottom = 400. 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! !