The Trunk: MorphicTests-mt.32.mcz

Marcel Taeumel uploaded a new version of MorphicTests to project The Trunk:
http://source.squeak.org/trunk/MorphicTests-mt.32.mcz

==================== Summary ====================

Name: MorphicTests-mt.32
Author: mt
Time: 4 June 2016, 6:47:00.72143 pm
UUID: 6e6d2a48-7a28-8244-9ade-c9db739c7b17
Ancestors: MorphicTests-mt.31

Adds tests for user input event handling and event filters.

=============== Diff against MorphicTests-mt.31 ===============

Item was changed:
  SystemOrganization addCategory: #'MorphicTests-Basic'!
  SystemOrganization addCategory: #'MorphicTests-Kernel'!
  SystemOrganization addCategory: #'MorphicTests-Layouts'!
  SystemOrganization addCategory: #'MorphicTests-Support'!
  SystemOrganization addCategory: #'MorphicTests-Text Support'!
  SystemOrganization addCategory: #'MorphicTests-ToolBuilder'!
  SystemOrganization addCategory: #'MorphicTests-Widgets'!
  SystemOrganization addCategory: #'MorphicTests-Worlds'!
+ SystemOrganization addCategory: #'MorphicTests-Events'!

Item was added:
+ Morph subclass: #MorphForEventTests
+ instanceVariableNames: 'eventsDuringCapture eventsDuringBubble eventsRejected eventsFiltered handlesMouseDown'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'MorphicTests-Events'!

Item was added:
+ ----- Method: MorphForEventTests>>eventsDuringBubble (in category 'accessing') -----
+ eventsDuringBubble
+ ^ eventsDuringBubble ifNil: [eventsDuringBubble := OrderedCollection new]!

Item was added:
+ ----- Method: MorphForEventTests>>eventsDuringCapture (in category 'accessing') -----
+ eventsDuringCapture
+ ^ eventsDuringCapture ifNil: [eventsDuringCapture := OrderedCollection new]!

Item was added:
+ ----- Method: MorphForEventTests>>eventsFiltered (in category 'accessing') -----
+ eventsFiltered
+ ^ eventsFiltered ifNil: [eventsFiltered := OrderedCollection new]!

Item was added:
+ ----- Method: MorphForEventTests>>eventsRejected (in category 'accessing') -----
+ eventsRejected
+ ^ eventsRejected ifNil: [eventsRejected := OrderedCollection new]!

Item was added:
+ ----- Method: MorphForEventTests>>filterEvent:for: (in category 'event filtering') -----
+ filterEvent: anEvent for: aMorphOrNil
+
+ self eventsFiltered add: anEvent copy -> aMorphOrNil.
+ ^ anEvent!

Item was added:
+ ----- Method: MorphForEventTests>>handleEvent: (in category 'events-processing') -----
+ handleEvent: anEvent
+
+ self eventsDuringBubble add: anEvent copy.
+ ^ super handleEvent: anEvent!

Item was added:
+ ----- Method: MorphForEventTests>>handlesKeyboard: (in category 'event handling') -----
+ handlesKeyboard: evt
+ ^ true!

Item was added:
+ ----- Method: MorphForEventTests>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ ^ handlesMouseDown ifNil: [true]!

Item was added:
+ ----- Method: MorphForEventTests>>handlesMouseMove: (in category 'event handling') -----
+ handlesMouseMove: evt
+ ^ true!

Item was added:
+ ----- Method: MorphForEventTests>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: evt
+ ^ true!

Item was added:
+ ----- Method: MorphForEventTests>>handlesMouseOverDragging: (in category 'event handling') -----
+ handlesMouseOverDragging: evt
+ ^ true!

Item was added:
+ ----- Method: MorphForEventTests>>handlesMouseStillDown: (in category 'event handling') -----
+ handlesMouseStillDown: evt
+ ^ true!

Item was added:
+ ----- Method: MorphForEventTests>>noMouseDown (in category 'accessing') -----
+ noMouseDown
+
+ handlesMouseDown := false.!

Item was added:
+ ----- Method: MorphForEventTests>>processEvent:using: (in category 'events-processing') -----
+ processEvent: anEvent using: dispatcher
+
+ self eventsDuringCapture add: anEvent copy.
+ ^ super processEvent: anEvent using: dispatcher!

Item was added:
+ ----- Method: MorphForEventTests>>rejectsEvent: (in category 'events-processing') -----
+ rejectsEvent: anEvent
+
+ ^ (super rejectsEvent: anEvent)
+ ifTrue: [self eventsRejected add: anEvent copy. true]
+ ifFalse: [false]!

Item was added:
+ UserInputEventTests subclass: #MorphicEventDispatcherTests
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'MorphicTests-Events'!

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test01EventBubbling (in category 'tests') -----
+ test01EventBubbling
+
+ | m1 m2 m3 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ self assert: m3 eventsDuringBubble isEmpty.
+ self assert: m2 eventsDuringBubble isEmpty.
+ self assert: m1 eventsDuringBubble isEmpty.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: (m3 eventsDuringBubble anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m2 eventsDuringBubble anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m1 eventsDuringBubble anySatisfy: [:ea | ea isMouseDown]).!

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test02EventCapturing (in category 'tests') -----
+ test02EventCapturing
+
+ | m1 m2 m3 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ self assert: m3 eventsDuringCapture isEmpty.
+ self assert: m2 eventsDuringCapture isEmpty.
+ self assert: m1 eventsDuringCapture isEmpty.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: (m3 eventsDuringCapture anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m2 eventsDuringCapture anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m1 eventsDuringCapture anySatisfy: [:ea | ea isMouseDown]).!

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test03EventRejecting (in category 'tests') -----
+ test03EventRejecting
+
+ | m1 m2 m3 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m2 lock. "to reject events"
+ m1 openInWorld: world.
+
+ self assert: m2 eventsRejected isEmpty.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: (m2 eventsRejected anySatisfy: [:ea | ea isMouseDown]).
+ self assert: m2 eventsDuringBubble isEmpty.
+ self assert: m2 eventsDuringCapture notEmpty.
+
+ self assert: m1 eventsRejected isEmpty.
+ self assert: m1 eventsDuringBubble notEmpty.
+ self assert: m1 eventsDuringCapture notEmpty.
+
+ self assert: m3 eventsRejected isEmpty.
+ self assert: m3 eventsDuringBubble isEmpty.
+ self assert: m3 eventsDuringCapture isEmpty.!

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test04OverlappingSiblings (in category 'tests') -----
+ test04OverlappingSiblings
+ "Only one of two overlapping siblings gets the event."
+
+ | m1 m2 m3 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m1 addMorph: m3.
+
+ m2 bounds: m3 bounds. "full overlap"
+
+ m1 openInWorld: world.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: (m3 eventsDuringBubble anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m2 eventsDuringBubble isEmpty).
+
+ self assert: (m3 eventsDuringCapture anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m2 eventsDuringCapture isEmpty).!

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test05FocusEventBubbling (in category 'tests') -----
+ test05FocusEventBubbling
+
+ | m1 m2 m3 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ self assert: m3 eventsDuringBubble isEmpty.
+ self assert: m2 eventsDuringBubble isEmpty.
+ self assert: m1 eventsDuringBubble isEmpty.
+
+ hand newMouseFocus: m2. "Not m3!! Due to focus, m3 is not considered during capturing/bubbling phase."
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: m3 eventsDuringBubble isEmpty.
+ self assert: (m2 eventsDuringBubble anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m1 eventsDuringBubble anySatisfy: [:ea | ea isMouseDown]).
+
+ hand newKeyboardFocus: m2.
+ hand handleEvent: (self keystroke: $x at: m3 center).
+
+ self assert: m3 eventsDuringBubble isEmpty.
+ self assert: (m2 eventsDuringBubble anySatisfy: [:ea | ea isKeystroke]).
+ self assert: (m1 eventsDuringBubble anySatisfy: [:ea | ea isKeystroke]).
+ !

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test06FocusEventCapturing (in category 'tests') -----
+ test06FocusEventCapturing
+ "There is no capturing phase for focus events."
+
+ | m1 m2 m3 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ self assert: m3 eventsDuringCapture isEmpty.
+ self assert: m2 eventsDuringCapture isEmpty.
+ self assert: m1 eventsDuringCapture isEmpty.
+
+ hand newMouseFocus: m2. "Not m3!! Due to focus, m3 is not considered during capturing/bubbling phase."
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: m3 eventsDuringCapture isEmpty.
+ self assert: m2 eventsDuringCapture isEmpty.
+ self assert: m1 eventsDuringCapture isEmpty.
+
+ hand newKeyboardFocus: m2.
+ hand handleEvent: (self keystroke: $x at: m3 center).
+
+ self assert: m3 eventsDuringCapture isEmpty.
+ self assert: m2 eventsDuringCapture isEmpty.
+ self assert: m1 eventsDuringCapture isEmpty.!

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test07EventNoBubbling (in category 'tests') -----
+ test07EventNoBubbling
+ "There is no bubbling if no morph handles the event."
+
+ | m1 m2 m3 |
+ m1 := MorphForEventTests new noMouseDown.
+ m2 := MorphForEventTests new noMouseDown.
+ m3 := MorphForEventTests new noMouseDown.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ self assert: m3 eventsDuringBubble isEmpty.
+ self assert: m2 eventsDuringBubble isEmpty.
+ self assert: m1 eventsDuringBubble isEmpty.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: (m3 eventsDuringBubble noneSatisfy: [:ea | ea isMouseDown]).
+ self assert: (m2 eventsDuringBubble noneSatisfy: [:ea | ea isMouseDown]).
+ self assert: (m1 eventsDuringBubble noneSatisfy: [:ea | ea isMouseDown]).!

Item was added:
+ UserInputEventTests subclass: #MorphicEventFilterTests
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'MorphicTests-Events'!

Item was added:
+ ----- Method: MorphicEventFilterTests>>test01EventBubbleFilter (in category 'tests') -----
+ test01EventBubbleFilter
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := MorphForEventTests new.
+
+ m1 addEventBubbleFilter: filter.
+ m2 addEventBubbleFilter: filter.
+ m3 addEventBubbleFilter: filter.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: {m3.m2.m1} equals: (filter eventsFiltered select: [:ea | ea key isMouseDown] thenCollect: [:ea | ea value]) asArray.!

Item was added:
+ ----- Method: MorphicEventFilterTests>>test02EventCaptureFilter (in category 'tests') -----
+ test02EventCaptureFilter
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := MorphForEventTests new.
+
+ m1 addEventCaptureFilter: filter.
+ m2 addEventCaptureFilter: filter.
+ m3 addEventCaptureFilter: filter.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: {m1.m2.m3} equals: (filter eventsFiltered select: [:ea | ea key isMouseDown] thenCollect: [:ea | ea value]) asArray.!

Item was added:
+ ----- Method: MorphicEventFilterTests>>test03FocusEventBubbleFilter (in category 'tests') -----
+ test03FocusEventBubbleFilter
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := MorphForEventTests new.
+
+ m1 addEventBubbleFilter: filter.
+ m2 addEventBubbleFilter: filter.
+ m3 addEventBubbleFilter: filter.
+
+ hand newMouseFocus: m2.
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: {m2.m1} equals: (filter eventsFiltered select: [:ea | ea key isMouseDown] thenCollect: [:ea | ea value]) asArray.!

Item was added:
+ ----- Method: MorphicEventFilterTests>>test04FocusEventCaptureFilter (in category 'tests') -----
+ test04FocusEventCaptureFilter
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := MorphForEventTests new.
+
+ m1 addEventCaptureFilter: filter.
+ m2 addEventCaptureFilter: filter.
+ m3 addEventCaptureFilter: filter.
+
+ hand newMouseFocus: m2.
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: {m1.m2} equals: (filter eventsFiltered select: [:ea | ea key isMouseDown] thenCollect: [:ea | ea value]) asArray.!

Item was added:
+ ----- Method: MorphicEventFilterTests>>test05IgnoreEvent (in category 'tests') -----
+ test05IgnoreEvent
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := PluggableEventFilter on: [:event | event ignore].
+
+ m1 addEventCaptureFilter: filter.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: m1 eventsDuringBubble isEmpty.
+ self assert: m2 eventsDuringBubble isEmpty.
+ self assert: m3 eventsDuringBubble isEmpty.
+
+ self assert: m1 eventsDuringCapture notEmpty.
+ self assert: m2 eventsDuringCapture isEmpty.
+ self assert: m3 eventsDuringCapture isEmpty.!

Item was added:
+ ----- Method: MorphicEventFilterTests>>test06IgnoreFocusEvent (in category 'tests') -----
+ test06IgnoreFocusEvent
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := PluggableEventFilter on: [:event | event ignore].
+
+ m1 addEventCaptureFilter: filter.
+
+ hand newMouseFocus: m3.
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: m1 eventsDuringBubble isEmpty.
+ self assert: m2 eventsDuringBubble isEmpty.
+ self assert: m3 eventsDuringBubble isEmpty.
+
+ self assert: m1 eventsDuringCapture isEmpty.
+ self assert: m2 eventsDuringCapture isEmpty.
+ self assert: m3 eventsDuringCapture isEmpty.!

Item was added:
+ ----- Method: MorphicEventFilterTests>>test07TransformEvent (in category 'tests') -----
+ test07TransformEvent
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := PluggableEventFilter on: [:event | self keystroke: $x at: m3 center].
+ m2 addEventCaptureFilter: filter.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: (m1 eventsDuringCapture anySatisfy: [:evt | evt isMouseDown]).
+ self assert: (m2 eventsDuringCapture anySatisfy: [:evt | evt isMouseDown]).
+ self assert: (m3 eventsDuringCapture anySatisfy: [:evt | evt isKeystroke]).
+
+ self assert: (m3 eventsDuringBubble anySatisfy: [:evt | evt isKeystroke]).
+ self assert: (m2 eventsDuringBubble anySatisfy: [:evt | evt isKeystroke]).
+ self assert: (m1 eventsDuringBubble anySatisfy: [:evt | evt isKeystroke]).
+ !

Item was added:
+ ----- Method: MorphicEventFilterTests>>test08TransformEventAgain (in category 'tests') -----
+ test08TransformEventAgain
+
+ | m1 m2 m3 filter |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := PluggableEventFilter on: [:event | self keystroke: $x at: m3 center].
+ m2 addEventBubbleFilter: filter.
+
+ hand handleEvent: (self redMouseDownAt: m3 center).
+
+ self assert: (m1 eventsDuringCapture anySatisfy: [:evt | evt isMouseDown]).
+ self assert: (m2 eventsDuringCapture anySatisfy: [:evt | evt isMouseDown]).
+ self assert: (m3 eventsDuringCapture anySatisfy: [:evt | evt isMouseDown]).
+
+ self assert: (m3 eventsDuringBubble anySatisfy: [:evt | evt isMouseDown]).
+ self assert: (m2 eventsDuringBubble anySatisfy: [:evt | evt isMouseDown]).
+ self assert: (m1 eventsDuringBubble anySatisfy: [:evt | evt isKeystroke]).
+ !

Item was added:
+ ----- Method: MorphicEventFilterTests>>test09KeyboardShortcut (in category 'tests') -----
+ test09KeyboardShortcut
+
+ | m1 m2 m3 filter hit |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+ m3 := MorphForEventTests new.
+
+ m1 addMorph: m2.
+ m2 addMorph: m3.
+
+ m1 openInWorld: world.
+
+ filter := PluggableEventFilter on: [:event |
+ hit := false.
+ (event isKeystroke and: [event keyCharacter = $x]) ifTrue: [
+ hit := true.
+ event ignore].
+ event].
+
+ m1 addKeyboardCaptureFilter: filter.
+
+ hand handleEvent: (self keystroke: $x at: m3 center).
+
+ self assert: hit.
+
+ self assert: (m1 eventsDuringCapture anySatisfy: [:evt | evt isKeystroke]).
+ self assert: (m2 eventsDuringCapture noneSatisfy: [:evt | evt isKeystroke]).
+ self assert: (m3 eventsDuringCapture noneSatisfy: [:evt | evt isKeystroke]).
+
+ self assert: (m3 eventsDuringBubble noneSatisfy: [:evt | evt isKeystroke]).
+ self assert: (m2 eventsDuringBubble noneSatisfy: [:evt | evt isKeystroke]).
+ self assert: (m1 eventsDuringBubble noneSatisfy: [:evt | evt isKeystroke]).
+
+ m1 eventsDuringCapture removeAll.
+ hand handleEvent: (self keystroke: $o at: m3 center).
+
+ self deny: hit.
+
+ self assert: (m1 eventsDuringCapture anySatisfy: [:evt | evt isKeystroke]).
+ self assert: (m2 eventsDuringCapture anySatisfy: [:evt | evt isKeystroke]).
+ self assert: (m3 eventsDuringCapture anySatisfy: [:evt | evt isKeystroke]).
+
+ self assert: (m3 eventsDuringBubble anySatisfy: [:evt | evt isKeystroke]).
+ self assert: (m2 eventsDuringBubble anySatisfy: [:evt | evt isKeystroke]).
+ self assert: (m1 eventsDuringBubble anySatisfy: [:evt | evt isKeystroke]).
+
+
+
+ !

Item was added:
+ UserInputEventTests subclass: #MorphicEventTests
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'MorphicTests-Events'!

Item was added:
+ ----- Method: MorphicEventTests>>test01WantsKeyboardFocus (in category 'tests') -----
+ test01WantsKeyboardFocus
+
+ | ptm |
+ ptm := PluggableTextMorph new.
+ ptm setText: 'test01WantsKeyboardFocus'.
+ ptm openInWorld: world.
+
+ self deny: (ptm hasKeyboardFocus: hand).
+ self deny: (ptm textMorph hasKeyboardFocus: hand).
+
+ self assert: ptm wantsKeyboardFocus.
+ self assert: ptm keyboardFocusDelegate == ptm textMorph.
+
+ hand handleEvent: (self redMouseDownAt: ptm center).
+ self assert: (ptm hasKeyboardFocus: hand).
+ self assert: (ptm textMorph hasKeyboardFocus: hand).
+ !

Item was added:
+ ----- Method: MorphicEventTests>>test02MouserOver (in category 'tests') -----
+ test02MouserOver
+
+ | m1 m2 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+
+ m1 extent: 20@20; topLeft: 0@0.
+ m2 extent: 20@20; topLeft: 40@0.
+
+ m1 openInWorld: world.
+ m2 openInWorld: world.
+
+ hand handleEvent: (self redMouseDownAt: m1 center).
+ hand handleEvent: (self redMouseUpAt: m1 center).
+ hand handleEvent: (self redMouseDownAt: m2 center).
+ hand handleEvent: (self redMouseUpAt: m2 center).
+
+ self
+ checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp mouseLeave)
+ forEvents: m1 eventsDuringBubble
+ ignoreMouseOver: true.
+
+ self
+ checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp)
+ forEvents: m2 eventsDuringBubble
+ ignoreMouseOver: true.
+ !

Item was added:
+ TestCase subclass: #UserInputEventTests
+ instanceVariableNames: 'hand world'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'MorphicTests-Events'!

Item was added:
+ ----- Method: UserInputEventTests>>checkEventOrder:forEvents:ignoreMouseOver: (in category 'support') -----
+ checkEventOrder: someEventTypes forEvents: someEvents ignoreMouseOver: ignoreMouseOver
+ "Use this to verify the order of events"
+
+ ((someEvents
+ select: [:ea | ea isMouseOver not or: [ignoreMouseOver not]])
+ collect: [:ea | ea type])
+ with: someEventTypes
+ do: [:t1 :t2 | self assert: t2 equals: t1].
+ !

Item was added:
+ ----- Method: UserInputEventTests>>keystroke:at: (in category 'support') -----
+ keystroke: char at: point
+
+ ^ KeyboardEvent new
+ setType: #keystroke
+ buttons: 0 "no modifiers"
+ position: point
+ keyValue: char asciiValue
+ hand: hand
+ stamp: Time millisecondClockValue!

Item was added:
+ ----- Method: UserInputEventTests>>redMouseDownAt: (in category 'support') -----
+ redMouseDownAt: point
+
+ ^ MouseButtonEvent new
+ setType: #mouseDown
+ position: point
+ which: 2r000 "no change"
+ buttons: 2r100 "red/left pressed"
+ hand: hand
+ stamp: Time millisecondClockValue!

Item was added:
+ ----- Method: UserInputEventTests>>redMouseUpAt: (in category 'support') -----
+ redMouseUpAt: point
+
+ ^ MouseButtonEvent new
+ setType: #mouseUp
+ position: point
+ which: 2r100 "red/left changed"
+ buttons: 2r000 "nothing pressed"
+ hand: hand
+ stamp: Time millisecondClockValue!

Item was added:
+ ----- Method: UserInputEventTests>>setUp (in category 'running') -----
+ setUp
+
+ super setUp.
+
+ world := (PasteUpMorph newWorldForProject: nil)
+ extent: 300@200;
+ viewBox: (0@0 extent: 300@200);
+ yourself.
+
+ (world instVarNamed: #worldState)
+ instVarNamed: #canvas
+ put: (Form extent: 300@200 depth: 32) getCanvas.
+
+ hand := world firstHand.!