The Trunk: MorphicTests-mt.64.mcz

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

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

Name: MorphicTests-mt.64
Author: mt
Time: 14 August 2020, 1:26:13.995535 pm
UUID: b4766a80-6197-4c67-bbdf-063e0bbb2d23
Ancestors: MorphicTests-nice.63

Adds test about custom Morphic event dispatcher.

=============== Diff against MorphicTests-nice.63 ===============

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

Item was added:
+ ----- Method: MorphForEventTests>>defaultEventDispatcher (in category 'events-processing') -----
+ defaultEventDispatcher
+
+ ^ self eventDispatcher ifNil: [super defaultEventDispatcher]!

Item was added:
+ ----- Method: MorphForEventTests>>eventDispatcher (in category 'accessing') -----
+ eventDispatcher
+
+ ^ eventDispatcher!

Item was added:
+ ----- Method: MorphForEventTests>>eventDispatcher: (in category 'accessing') -----
+ eventDispatcher: anEventDispatcher
+
+ eventDispatcher := anEventDispatcher.!

Item was added:
+ MorphicEventDispatcher subclass: #MorphicEventDispatcherForEventTests
+ instanceVariableNames: 'eventsSeen morphsSeen'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'MorphicTests-Events'!

Item was added:
+ ----- Method: MorphicEventDispatcherForEventTests>>dispatchEvent:with: (in category 'dispatching') -----
+ dispatchEvent: anEvent with: aMorph
+
+ self eventsSeen add: anEvent copy.
+ self morphsSeen add: aMorph.
+ ^ super dispatchEvent: anEvent with: aMorph!

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

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

Item was added:
+ ----- Method: MorphicEventDispatcherTests>>test12CustomEventDispatcher (in category 'tests') -----
+ test12CustomEventDispatcher
+ "Each morph can choose to use a custom event dispatcher."
+
+ | m1 m2 |
+ m1 := MorphForEventTests new.
+ m1 eventDispatcher: MorphicEventDispatcherForEventTests new.
+
+ m2 := MorphForEventTests new.
+ m2 eventDispatcher: MorphicEventDispatcherForEventTests new.
+
+ m2 bounds: m1 bounds.
+ m1 addMorph: m2. "full overlap"
+
+ m1 openInWorld: world.
+
+ self deny: (m1 eventDispatcher eventsSeen anySatisfy: [:ea | ea isMouseDown]).
+ self deny: (m2 eventDispatcher eventsSeen anySatisfy: [:ea | ea isMouseDown]).
+
+ hand handleEvent: (self redMouseDownAt: m2 center).
+
+ self assert: (m1 eventDispatcher eventsSeen anySatisfy: [:ea | ea isMouseDown]).
+ self assert: (m2 eventDispatcher eventsSeen anySatisfy: [:ea | ea isMouseDown]).!