The Inbox: Morphic-nice.1613.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
6 messages Options
Reply | Threaded
Open this post in threaded view
|

The Inbox: Morphic-nice.1613.mcz

commits-2
Nicolas Cellier uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-nice.1613.mcz

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

Name: Morphic-nice.1613
Author: nice
Time: 27 December 2019, 10:57:36.813907 pm
UUID: 07043442-aa16-4af4-9123-601cd503346a
Ancestors: Morphic-mt.1612

Provide smoother scrolling in response to mouse wheel events

Instead of delivering the events when delta reaches 120, make this threshold a Preference (minimumWheelDelta)

Reminder: 120 represents a single notch for traditional mouse wheel with notches, but trackpads can deliver much smaller deltas

Rather than accumulating the deltas into MouseWheelState, do it when we #generateMouseWheelEvent:
Indeed, small deltas will come in packets of successive events, and it's more efficient to regroup then, a bit like we do with mouse trails...

Also MouseWheelState did ignore time outs (long delays between deltas) and other state changes (buttons/modifiers), which was not ideal.

Directly get those states from the raw eventBuffer, like any other mouse event. This requires integration of tose 2 PR:
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/461 for Windows
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/462 for OSX and linux

Honour larger deltas too in ScrollPane>>#mouseWheel: event handling
Honour horizontal mouse wheels too in ScrollPane

With patched VM, and following settings, I get a reasonnable scrolling experience on OSX:

        HandMorph minimumWheelDelta: 20.
        Smalltalk sendMouseWheelEvents: true.

=============== Diff against Morphic-mt.1612 ===============

Item was changed:
  Morph subclass: #HandMorph
  instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler mouseWheelState lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
+ classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
  poolDictionaries: 'EventSensorConstants'
  category: 'Morphic-Kernel'!
 
  !HandMorph commentStamp: '<historical>' prior: 0!
  The cursor may be thought of as the HandMorph.  The hand's submorphs hold anything being carried by dragging.  
 
  There is some minimal support for multiple hands in the same world.!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta (in category 'preferences') -----
+ minimumWheelDelta
+ <preference: 'Minimal Mouse Wheel Scroll Delta'
+ categoryList: #(Morphic mouse)
+ description: 'Answer the minimal scroll increment taken into account
+ Defaults to 120, corresponding to a single mouse wheel notch.
+ Use a lower value (20) if wanting smoother scrolling with trackpads.'
+ type: #Number>
+ ^MinimalWheelDelta ifNil: [120].!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta: (in category 'preferences') -----
+ minimumWheelDelta: anInteger
+ MinimalWheelDelta := anInteger ifNotNil: [anInteger clampLow: 20 high: 120]!

Item was changed:
  ----- Method: HandMorph>>generateMouseWheelEvent: (in category 'private events') -----
  generateMouseWheelEvent: evtBuf
  "Generate the appropriate mouse wheel event for the given raw event buffer"
 
+ | buttons modifiers deltaX deltaY stamp nextEvent |
- | buttons modifiers deltaX deltaY stamp |
  stamp := evtBuf second.
  stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
  deltaX := evtBuf third.
  deltaY := evtBuf fourth.
+ buttons := evtBuf fifth.
+ modifiers := evtBuf sixth.
+ [(deltaX abs + deltaY abs < self class minimumWheelDelta)
+ and: [(nextEvent := Sensor peekEvent) notNil
+ and: [nextEvent first = evtBuf first
+ and: [nextEvent fifth = evtBuf fifth
+ and: [nextEvent sixth = evtBuf sixth]
+ and: [nextEvent third isZero = evtBuf third isZero "both horizontal or vertical"]]]]]
+ whileTrue:
+ ["nextEvent is similar.  Remove it from the queue, and check the next."
+ nextEvent := Sensor nextEvent.
+ deltaX := deltaX + nextEvent third.
+ deltaY := deltaY + nextEvent fourth].
- modifiers := evtBuf fifth.
- buttons := (modifiers bitShift: 3) bitOr: (lastMouseEvent buttons bitAnd: 7).
  ^ MouseWheelEvent new
  setType: #mouseWheel
  position: self position
  delta: deltaX@deltaY
- direction: 2r0000
  buttons: buttons
  hand: self
  stamp: stamp!

Item was changed:
  ----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
  handleEvent: unfilteredEvent
 
  | filteredEvent |
  owner ifNil: [^ unfilteredEvent  "not necessary but good style -- see Morph >> #handleEvent:"].
 
  self logEvent: unfilteredEvent.
 
  "Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
  unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].
 
  self showEvent: unfilteredEvent.
  self sendListenEvents: unfilteredEvent.
 
  filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
  "filteredEvent := unfilteredEvent" " <-- use this to disable global capture filters"
 
  filteredEvent wasIgnored ifTrue: [
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isWindowEvent ifTrue: [
  self sendEvent: filteredEvent focus: nil.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isKeyboard ifTrue:[
  self sendKeyboardEvent: filteredEvent.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isDropEvent ifTrue:[
  self sendEvent: filteredEvent focus: nil.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isMouse ifFalse: [
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  " ********** MOUSE EVENT *********** "
 
  lastMouseEvent := filteredEvent.
 
  "Check for pending drag or double click operations."
  mouseClickState ifNotNil:[
  (mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
  "Possibly dispatched #click: or something and will not re-establish otherwise"
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent]].
 
  filteredEvent isMouseWheel ifTrue: [
+ self class sendMouseWheelToKeyboardFocus
+ ifFalse: [self sendMouseEvent: filteredEvent]
+ ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
- mouseWheelState ifNil: [mouseWheelState := MouseWheelState new].
- mouseWheelState handleEvent: filteredEvent from: self.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isMove ifTrue:[
  self position: filteredEvent position.
  self sendMouseEvent: filteredEvent.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  "Issue a synthetic move event if we're not at the position of the event"
  filteredEvent position = self position
  ifFalse: [self moveToEvent: filteredEvent].
 
  "Drop submorphs on button events"
  self hasSubmorphs
  ifTrue:[self dropMorphs: filteredEvent]
  ifFalse:[self sendMouseEvent: filteredEvent].
 
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !

Item was added:
+ ----- Method: MouseWheelEvent>>setDirection (in category 'initialization') -----
+ setDirection
+ delta x > 0 ifTrue: [self setWheelRight].
+ delta x < 0 ifTrue: [self setWheelLeft].
+
+ delta y > 0 ifTrue: [self setWheelUp].
+ delta y < 0 ifTrue: [self setWheelDown].!

Item was added:
+ ----- Method: MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category 'private') -----
+ setType: evtType position: evtPos delta: evtDelta buttons: evtButtons hand: evtHand stamp: stamp
+ type := evtType.
+ position := evtPos.
+ buttons := evtButtons.
+ source := evtHand.
+ wasHandled := false.
+ direction := 2r0000.
+ delta := evtDelta.
+ timeStamp := stamp.
+ self setDirection!

Item was removed:
- Object subclass: #MouseWheelState
- instanceVariableNames: 'currentDelta'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!

Item was removed:
- ----- Method: MouseWheelState>>handleEvent:from: (in category 'event processing') -----
- handleEvent: aMouseWheelEvent from: aHand
- "Every 120 units, raise the wheel flags for convenient mouse wheel programming. We choose not to send multiple mouse-wheel events for multiples of 120 because applications can always react to the actual delta values if they want to do more scrolling or zooming."
-
- | sign |
- currentDelta := currentDelta + aMouseWheelEvent wheelDelta.
-
- sign := currentDelta sign.
- currentDelta := currentDelta abs.
-
- (currentDelta x // 120) > 0 ifTrue: [
- sign x = 1
- ifTrue: [aMouseWheelEvent setWheelRight]
- ifFalse: [aMouseWheelEvent setWheelLeft]].
-
- (currentDelta y // 120) > 0 ifTrue: [
- sign y = 1
- ifTrue: [aMouseWheelEvent setWheelUp]
- ifFalse: [aMouseWheelEvent setWheelDown]].
-
- currentDelta := currentDelta \\ 120.
- currentDelta := currentDelta * sign.
-
- "Finally, send the event."
- HandMorph sendMouseWheelToKeyboardFocus
- ifFalse: [aHand sendMouseEvent: aMouseWheelEvent]
- ifTrue: [aHand sendEvent: aMouseWheelEvent focus: aHand keyboardFocus clear: [aHand keyboardFocus: nil]].
- !

Item was removed:
- ----- Method: MouseWheelState>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
- currentDelta := 0@0.!

Item was changed:
  ----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
  mouseWheel: evt
 
+ evt isWheelUp ifTrue: [scrollBar scrollUp: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelDown ifTrue: [scrollBar scrollDown: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelLeft ifTrue: [hScrollBar scrollUp: (3 * evt wheelDelta x abs // 120 max: 1)].
+ evt isWheelRight ifTrue: [hScrollBar scrollDown: (3 * evt wheelDelta x abs // 120 max: 1)].!
- evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
- evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-nice.1613.mcz

marcel.taeumel
Hmm... so you want to move any delta aggregation into the VM but keep delta-to-event mapping inside the image. In a perfect world, this would be the way to go. But the use of "Sensor peekEvent" is really, really, really unfortunate! :-) I would try to remove it the next time I stumble over it. :-D Sorry.

Considering cross-platform VM issues in the past, I would rather not remove the delta aggregation (or delta mapping) from the image. MouseWheelState took inspiration from MouseClickState and MouseOverHandler.

So, I vote for:

- make delta aggregation (or mapping) optional in the image via a preference
- add that time-out to MouseWheelState
- no calls to "Sensor peekEvent" in HandMorph under any circumstances ... please :-)

Best,
Marcel

Am 27.12.2019 22:58:16 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-nice.1613.mcz

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

Name: Morphic-nice.1613
Author: nice
Time: 27 December 2019, 10:57:36.813907 pm
UUID: 07043442-aa16-4af4-9123-601cd503346a
Ancestors: Morphic-mt.1612

Provide smoother scrolling in response to mouse wheel events

Instead of delivering the events when delta reaches 120, make this threshold a Preference (minimumWheelDelta)

Reminder: 120 represents a single notch for traditional mouse wheel with notches, but trackpads can deliver much smaller deltas

Rather than accumulating the deltas into MouseWheelState, do it when we #generateMouseWheelEvent:
Indeed, small deltas will come in packets of successive events, and it's more efficient to regroup then, a bit like we do with mouse trails...

Also MouseWheelState did ignore time outs (long delays between deltas) and other state changes (buttons/modifiers), which was not ideal.

Directly get those states from the raw eventBuffer, like any other mouse event. This requires integration of tose 2 PR:
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/461 for Windows
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/462 for OSX and linux

Honour larger deltas too in ScrollPane>>#mouseWheel: event handling
Honour horizontal mouse wheels too in ScrollPane

With patched VM, and following settings, I get a reasonnable scrolling experience on OSX:

HandMorph minimumWheelDelta: 20.
Smalltalk sendMouseWheelEvents: true.

=============== Diff against Morphic-mt.1612 ===============

Item was changed:
Morph subclass: #HandMorph
instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler mouseWheelState lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
+ classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
poolDictionaries: 'EventSensorConstants'
category: 'Morphic-Kernel'!

!HandMorph commentStamp: '' prior: 0!
The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging.

There is some minimal support for multiple hands in the same world.!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta (in category 'preferences') -----
+ minimumWheelDelta
+
+ categoryList: #(Morphic mouse)
+ description: 'Answer the minimal scroll increment taken into account
+ Defaults to 120, corresponding to a single mouse wheel notch.
+ Use a lower value (20) if wanting smoother scrolling with trackpads.'
+ type: #Number>
+ ^MinimalWheelDelta ifNil: [120].!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta: (in category 'preferences') -----
+ minimumWheelDelta: anInteger
+ MinimalWheelDelta := anInteger ifNotNil: [anInteger clampLow: 20 high: 120]!

Item was changed:
----- Method: HandMorph>>generateMouseWheelEvent: (in category 'private events') -----
generateMouseWheelEvent: evtBuf
"Generate the appropriate mouse wheel event for the given raw event buffer"

+ | buttons modifiers deltaX deltaY stamp nextEvent |
- | buttons modifiers deltaX deltaY stamp |
stamp := evtBuf second.
stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
deltaX := evtBuf third.
deltaY := evtBuf fourth.
+ buttons := evtBuf fifth.
+ modifiers := evtBuf sixth.
+ [(deltaX abs + deltaY abs < self="" class="">
+ and: [(nextEvent := Sensor peekEvent) notNil
+ and: [nextEvent first = evtBuf first
+ and: [nextEvent fifth = evtBuf fifth
+ and: [nextEvent sixth = evtBuf sixth]
+ and: [nextEvent third isZero = evtBuf third isZero "both horizontal or vertical"]]]]]
+ whileTrue:
+ ["nextEvent is similar. Remove it from the queue, and check the next."
+ nextEvent := Sensor nextEvent.
+ deltaX := deltaX + nextEvent third.
+ deltaY := deltaY + nextEvent fourth].
- modifiers := evtBuf fifth.
- buttons := (modifiers bitShift: 3) bitOr: (lastMouseEvent buttons bitAnd: 7).
^ MouseWheelEvent new
setType: #mouseWheel
position: self position
delta: deltaX@deltaY
- direction: 2r0000
buttons: buttons
hand: self
stamp: stamp!

Item was changed:
----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
handleEvent: unfilteredEvent

| filteredEvent |
owner ifNil: [^ unfilteredEvent "not necessary but good style -- see Morph >> #handleEvent:"].

self logEvent: unfilteredEvent.

"Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].

self showEvent: unfilteredEvent.
self sendListenEvents: unfilteredEvent.

filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
"filteredEvent := unfilteredEvent" " <-- use="" this="" to="" disable="" global="" capture="">

filteredEvent wasIgnored ifTrue: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isWindowEvent ifTrue: [
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isKeyboard ifTrue:[
self sendKeyboardEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isDropEvent ifTrue:[
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMouse ifFalse: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

" ********** MOUSE EVENT *********** "

lastMouseEvent := filteredEvent.

"Check for pending drag or double click operations."
mouseClickState ifNotNil:[
(mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
"Possibly dispatched #click: or something and will not re-establish otherwise"
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent]].

filteredEvent isMouseWheel ifTrue: [
+ self class sendMouseWheelToKeyboardFocus
+ ifFalse: [self sendMouseEvent: filteredEvent]
+ ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
- mouseWheelState ifNil: [mouseWheelState := MouseWheelState new].
- mouseWheelState handleEvent: filteredEvent from: self.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMove ifTrue:[
self position: filteredEvent position.
self sendMouseEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

"Issue a synthetic move event if we're not at the position of the event"
filteredEvent position = self position
ifFalse: [self moveToEvent: filteredEvent].

"Drop submorphs on button events"
self hasSubmorphs
ifTrue:[self dropMorphs: filteredEvent]
ifFalse:[self sendMouseEvent: filteredEvent].

self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !

Item was added:
+ ----- Method: MouseWheelEvent>>setDirection (in category 'initialization') -----
+ setDirection
+ delta x > 0 ifTrue: [self setWheelRight].
+ delta x < 0="" iftrue:="" [self="">
+
+ delta y > 0 ifTrue: [self setWheelUp].
+ delta y < 0="" iftrue:="" [self="">

Item was added:
+ ----- Method: MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category 'private') -----
+ setType: evtType position: evtPos delta: evtDelta buttons: evtButtons hand: evtHand stamp: stamp
+ type := evtType.
+ position := evtPos.
+ buttons := evtButtons.
+ source := evtHand.
+ wasHandled := false.
+ direction := 2r0000.
+ delta := evtDelta.
+ timeStamp := stamp.
+ self setDirection!

Item was removed:
- Object subclass: #MouseWheelState
- instanceVariableNames: 'currentDelta'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!

Item was removed:
- ----- Method: MouseWheelState>>handleEvent:from: (in category 'event processing') -----
- handleEvent: aMouseWheelEvent from: aHand
- "Every 120 units, raise the wheel flags for convenient mouse wheel programming. We choose not to send multiple mouse-wheel events for multiples of 120 because applications can always react to the actual delta values if they want to do more scrolling or zooming."
-
- | sign |
- currentDelta := currentDelta + aMouseWheelEvent wheelDelta.
-
- sign := currentDelta sign.
- currentDelta := currentDelta abs.
-
- (currentDelta x // 120) > 0 ifTrue: [
- sign x = 1
- ifTrue: [aMouseWheelEvent setWheelRight]
- ifFalse: [aMouseWheelEvent setWheelLeft]].
-
- (currentDelta y // 120) > 0 ifTrue: [
- sign y = 1
- ifTrue: [aMouseWheelEvent setWheelUp]
- ifFalse: [aMouseWheelEvent setWheelDown]].
-
- currentDelta := currentDelta \\ 120.
- currentDelta := currentDelta * sign.
-
- "Finally, send the event."
- HandMorph sendMouseWheelToKeyboardFocus
- ifFalse: [aHand sendMouseEvent: aMouseWheelEvent]
- ifTrue: [aHand sendEvent: aMouseWheelEvent focus: aHand keyboardFocus clear: [aHand keyboardFocus: nil]].
- !

Item was removed:
- ----- Method: MouseWheelState>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
- currentDelta := 0@0.!

Item was changed:
----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
mouseWheel: evt

+ evt isWheelUp ifTrue: [scrollBar scrollUp: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelDown ifTrue: [scrollBar scrollDown: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelLeft ifTrue: [hScrollBar scrollUp: (3 * evt wheelDelta x abs // 120 max: 1)].
+ evt isWheelRight ifTrue: [hScrollBar scrollDown: (3 * evt wheelDelta x abs // 120 max: 1)].!
- evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
- evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!




Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-nice.1613.mcz

Nicolas Cellier
Hi Marcel,
this is the pragmatical result of experimentation.
Please try such a configuration:
- a VM that sends mouse wheel events
- Smalltalk sendMouseWheelEvents: true
- a computer with a trackpad (preferably a MacBook which sends many many such events)

So -1 for a Preferences, this is not a Preferences, this is a must, or we will never switch to sendMouseWheelEvents

Concerning peekEvent, sorry, I don't understand the problem.
I used the exact same solution than HandMorph>>mouseTrailFrom: (from #generateMouseEvent:)
If we send #peekEvent at every #mouseMove we can also send it at every mouse wheel.

IMO, global mouse wheel state serves  just complexifies things uselessly.
We don't want a global state (Or is it for MVC?)

Le lun. 6 janv. 2020 à 13:46, Marcel Taeumel <[hidden email]> a écrit :
Hmm... so you want to move any delta aggregation into the VM but keep delta-to-event mapping inside the image. In a perfect world, this would be the way to go. But the use of "Sensor peekEvent" is really, really, really unfortunate! :-) I would try to remove it the next time I stumble over it. :-D Sorry.

Considering cross-platform VM issues in the past, I would rather not remove the delta aggregation (or delta mapping) from the image. MouseWheelState took inspiration from MouseClickState and MouseOverHandler.

So, I vote for:

- make delta aggregation (or mapping) optional in the image via a preference
- add that time-out to MouseWheelState
- no calls to "Sensor peekEvent" in HandMorph under any circumstances ... please :-)

Best,
Marcel

Am 27.12.2019 22:58:16 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-nice.1613.mcz

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

Name: Morphic-nice.1613
Author: nice
Time: 27 December 2019, 10:57:36.813907 pm
UUID: 07043442-aa16-4af4-9123-601cd503346a
Ancestors: Morphic-mt.1612

Provide smoother scrolling in response to mouse wheel events

Instead of delivering the events when delta reaches 120, make this threshold a Preference (minimumWheelDelta)

Reminder: 120 represents a single notch for traditional mouse wheel with notches, but trackpads can deliver much smaller deltas

Rather than accumulating the deltas into MouseWheelState, do it when we #generateMouseWheelEvent:
Indeed, small deltas will come in packets of successive events, and it's more efficient to regroup then, a bit like we do with mouse trails...

Also MouseWheelState did ignore time outs (long delays between deltas) and other state changes (buttons/modifiers), which was not ideal.

Directly get those states from the raw eventBuffer, like any other mouse event. This requires integration of tose 2 PR:
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/461 for Windows
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/462 for OSX and linux

Honour larger deltas too in ScrollPane>>#mouseWheel: event handling
Honour horizontal mouse wheels too in ScrollPane

With patched VM, and following settings, I get a reasonnable scrolling experience on OSX:

HandMorph minimumWheelDelta: 20.
Smalltalk sendMouseWheelEvents: true.

=============== Diff against Morphic-mt.1612 ===============

Item was changed:
Morph subclass: #HandMorph
instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler mouseWheelState lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
+ classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
poolDictionaries: 'EventSensorConstants'
category: 'Morphic-Kernel'!

!HandMorph commentStamp: '' prior: 0!
The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging.

There is some minimal support for multiple hands in the same world.!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta (in category 'preferences') -----
+ minimumWheelDelta
+
+ categoryList: #(Morphic mouse)
+ description: 'Answer the minimal scroll increment taken into account
+ Defaults to 120, corresponding to a single mouse wheel notch.
+ Use a lower value (20) if wanting smoother scrolling with trackpads.'
+ type: #Number>
+ ^MinimalWheelDelta ifNil: [120].!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta: (in category 'preferences') -----
+ minimumWheelDelta: anInteger
+ MinimalWheelDelta := anInteger ifNotNil: [anInteger clampLow: 20 high: 120]!

Item was changed:
----- Method: HandMorph>>generateMouseWheelEvent: (in category 'private events') -----
generateMouseWheelEvent: evtBuf
"Generate the appropriate mouse wheel event for the given raw event buffer"

+ | buttons modifiers deltaX deltaY stamp nextEvent |
- | buttons modifiers deltaX deltaY stamp |
stamp := evtBuf second.
stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
deltaX := evtBuf third.
deltaY := evtBuf fourth.
+ buttons := evtBuf fifth.
+ modifiers := evtBuf sixth.
+ [(deltaX abs + deltaY abs < self="" class="">
+ and: [(nextEvent := Sensor peekEvent) notNil
+ and: [nextEvent first = evtBuf first
+ and: [nextEvent fifth = evtBuf fifth
+ and: [nextEvent sixth = evtBuf sixth]
+ and: [nextEvent third isZero = evtBuf third isZero "both horizontal or vertical"]]]]]
+ whileTrue:
+ ["nextEvent is similar. Remove it from the queue, and check the next."
+ nextEvent := Sensor nextEvent.
+ deltaX := deltaX + nextEvent third.
+ deltaY := deltaY + nextEvent fourth].
- modifiers := evtBuf fifth.
- buttons := (modifiers bitShift: 3) bitOr: (lastMouseEvent buttons bitAnd: 7).
^ MouseWheelEvent new
setType: #mouseWheel
position: self position
delta: deltaX@deltaY
- direction: 2r0000
buttons: buttons
hand: self
stamp: stamp!

Item was changed:
----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
handleEvent: unfilteredEvent

| filteredEvent |
owner ifNil: [^ unfilteredEvent "not necessary but good style -- see Morph >> #handleEvent:"].

self logEvent: unfilteredEvent.

"Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].

self showEvent: unfilteredEvent.
self sendListenEvents: unfilteredEvent.

filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
"filteredEvent := unfilteredEvent" " <-- use="" this="" to="" disable="" global="" capture="">

filteredEvent wasIgnored ifTrue: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isWindowEvent ifTrue: [
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isKeyboard ifTrue:[
self sendKeyboardEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isDropEvent ifTrue:[
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMouse ifFalse: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

" ********** MOUSE EVENT *********** "

lastMouseEvent := filteredEvent.

"Check for pending drag or double click operations."
mouseClickState ifNotNil:[
(mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
"Possibly dispatched #click: or something and will not re-establish otherwise"
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent]].

filteredEvent isMouseWheel ifTrue: [
+ self class sendMouseWheelToKeyboardFocus
+ ifFalse: [self sendMouseEvent: filteredEvent]
+ ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
- mouseWheelState ifNil: [mouseWheelState := MouseWheelState new].
- mouseWheelState handleEvent: filteredEvent from: self.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMove ifTrue:[
self position: filteredEvent position.
self sendMouseEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

"Issue a synthetic move event if we're not at the position of the event"
filteredEvent position = self position
ifFalse: [self moveToEvent: filteredEvent].

"Drop submorphs on button events"
self hasSubmorphs
ifTrue:[self dropMorphs: filteredEvent]
ifFalse:[self sendMouseEvent: filteredEvent].

self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !

Item was added:
+ ----- Method: MouseWheelEvent>>setDirection (in category 'initialization') -----
+ setDirection
+ delta x > 0 ifTrue: [self setWheelRight].
+ delta x < 0="" iftrue:="" [self="">
+
+ delta y > 0 ifTrue: [self setWheelUp].
+ delta y < 0="" iftrue:="" [self="">

Item was added:
+ ----- Method: MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category 'private') -----
+ setType: evtType position: evtPos delta: evtDelta buttons: evtButtons hand: evtHand stamp: stamp
+ type := evtType.
+ position := evtPos.
+ buttons := evtButtons.
+ source := evtHand.
+ wasHandled := false.
+ direction := 2r0000.
+ delta := evtDelta.
+ timeStamp := stamp.
+ self setDirection!

Item was removed:
- Object subclass: #MouseWheelState
- instanceVariableNames: 'currentDelta'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!

Item was removed:
- ----- Method: MouseWheelState>>handleEvent:from: (in category 'event processing') -----
- handleEvent: aMouseWheelEvent from: aHand
- "Every 120 units, raise the wheel flags for convenient mouse wheel programming. We choose not to send multiple mouse-wheel events for multiples of 120 because applications can always react to the actual delta values if they want to do more scrolling or zooming."
-
- | sign |
- currentDelta := currentDelta + aMouseWheelEvent wheelDelta.
-
- sign := currentDelta sign.
- currentDelta := currentDelta abs.
-
- (currentDelta x // 120) > 0 ifTrue: [
- sign x = 1
- ifTrue: [aMouseWheelEvent setWheelRight]
- ifFalse: [aMouseWheelEvent setWheelLeft]].
-
- (currentDelta y // 120) > 0 ifTrue: [
- sign y = 1
- ifTrue: [aMouseWheelEvent setWheelUp]
- ifFalse: [aMouseWheelEvent setWheelDown]].
-
- currentDelta := currentDelta \\ 120.
- currentDelta := currentDelta * sign.
-
- "Finally, send the event."
- HandMorph sendMouseWheelToKeyboardFocus
- ifFalse: [aHand sendMouseEvent: aMouseWheelEvent]
- ifTrue: [aHand sendEvent: aMouseWheelEvent focus: aHand keyboardFocus clear: [aHand keyboardFocus: nil]].
- !

Item was removed:
- ----- Method: MouseWheelState>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
- currentDelta := 0@0.!

Item was changed:
----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
mouseWheel: evt

+ evt isWheelUp ifTrue: [scrollBar scrollUp: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelDown ifTrue: [scrollBar scrollDown: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelLeft ifTrue: [hScrollBar scrollUp: (3 * evt wheelDelta x abs // 120 max: 1)].
+ evt isWheelRight ifTrue: [hScrollBar scrollDown: (3 * evt wheelDelta x abs // 120 max: 1)].!
- evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
- evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!





Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-nice.1613.mcz

marcel.taeumel
Hi Nicolas.

IMO, global mouse wheel state serves  just complexifies things uselessly.

Not global. Local to a hand. There can be multiple hands in an image.

So -1 for a Preferences, this is not a Preferences, this is a must, or we will never switch to sendMouseWheelEvents

Agreed. :-)

Also, smooth wheel scrolling is related to some magic numbers in PluggableTextMorph and ScrollPane (or ScrollBar). In any case an issue for after the 5.3 release. I suppose.

Best,
Marcel

Am 06.01.2020 14:10:54 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
this is the pragmatical result of experimentation.
Please try such a configuration:
- a VM that sends mouse wheel events
- Smalltalk sendMouseWheelEvents: true
- a computer with a trackpad (preferably a MacBook which sends many many such events)

So -1 for a Preferences, this is not a Preferences, this is a must, or we will never switch to sendMouseWheelEvents

Concerning peekEvent, sorry, I don't understand the problem.
I used the exact same solution than HandMorph>>mouseTrailFrom: (from #generateMouseEvent:)
If we send #peekEvent at every #mouseMove we can also send it at every mouse wheel.

IMO, global mouse wheel state serves  just complexifies things uselessly.
We don't want a global state (Or is it for MVC?)

Le lun. 6 janv. 2020 à 13:46, Marcel Taeumel <[hidden email]> a écrit :
Hmm... so you want to move any delta aggregation into the VM but keep delta-to-event mapping inside the image. In a perfect world, this would be the way to go. But the use of "Sensor peekEvent" is really, really, really unfortunate! :-) I would try to remove it the next time I stumble over it. :-D Sorry.

Considering cross-platform VM issues in the past, I would rather not remove the delta aggregation (or delta mapping) from the image. MouseWheelState took inspiration from MouseClickState and MouseOverHandler.

So, I vote for:

- make delta aggregation (or mapping) optional in the image via a preference
- add that time-out to MouseWheelState
- no calls to "Sensor peekEvent" in HandMorph under any circumstances ... please :-)

Best,
Marcel

Am 27.12.2019 22:58:16 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-nice.1613.mcz

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

Name: Morphic-nice.1613
Author: nice
Time: 27 December 2019, 10:57:36.813907 pm
UUID: 07043442-aa16-4af4-9123-601cd503346a
Ancestors: Morphic-mt.1612

Provide smoother scrolling in response to mouse wheel events

Instead of delivering the events when delta reaches 120, make this threshold a Preference (minimumWheelDelta)

Reminder: 120 represents a single notch for traditional mouse wheel with notches, but trackpads can deliver much smaller deltas

Rather than accumulating the deltas into MouseWheelState, do it when we #generateMouseWheelEvent:
Indeed, small deltas will come in packets of successive events, and it's more efficient to regroup then, a bit like we do with mouse trails...

Also MouseWheelState did ignore time outs (long delays between deltas) and other state changes (buttons/modifiers), which was not ideal.

Directly get those states from the raw eventBuffer, like any other mouse event. This requires integration of tose 2 PR:
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/461 for Windows
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/462 for OSX and linux

Honour larger deltas too in ScrollPane>>#mouseWheel: event handling
Honour horizontal mouse wheels too in ScrollPane

With patched VM, and following settings, I get a reasonnable scrolling experience on OSX:

HandMorph minimumWheelDelta: 20.
Smalltalk sendMouseWheelEvents: true.

=============== Diff against Morphic-mt.1612 ===============

Item was changed:
Morph subclass: #HandMorph
instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler mouseWheelState lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
+ classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
poolDictionaries: 'EventSensorConstants'
category: 'Morphic-Kernel'!

!HandMorph commentStamp: '' prior: 0!
The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging.

There is some minimal support for multiple hands in the same world.!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta (in category 'preferences') -----
+ minimumWheelDelta
+
+ categoryList: #(Morphic mouse)
+ description: 'Answer the minimal scroll increment taken into account
+ Defaults to 120, corresponding to a single mouse wheel notch.
+ Use a lower value (20) if wanting smoother scrolling with trackpads.'
+ type: #Number>
+ ^MinimalWheelDelta ifNil: [120].!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta: (in category 'preferences') -----
+ minimumWheelDelta: anInteger
+ MinimalWheelDelta := anInteger ifNotNil: [anInteger clampLow: 20 high: 120]!

Item was changed:
----- Method: HandMorph>>generateMouseWheelEvent: (in category 'private events') -----
generateMouseWheelEvent: evtBuf
"Generate the appropriate mouse wheel event for the given raw event buffer"

+ | buttons modifiers deltaX deltaY stamp nextEvent |
- | buttons modifiers deltaX deltaY stamp |
stamp := evtBuf second.
stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
deltaX := evtBuf third.
deltaY := evtBuf fourth.
+ buttons := evtBuf fifth.
+ modifiers := evtBuf sixth.
+ [(deltaX abs + deltaY abs < self="" class="">
+ and: [(nextEvent := Sensor peekEvent) notNil
+ and: [nextEvent first = evtBuf first
+ and: [nextEvent fifth = evtBuf fifth
+ and: [nextEvent sixth = evtBuf sixth]
+ and: [nextEvent third isZero = evtBuf third isZero "both horizontal or vertical"]]]]]
+ whileTrue:
+ ["nextEvent is similar. Remove it from the queue, and check the next."
+ nextEvent := Sensor nextEvent.
+ deltaX := deltaX + nextEvent third.
+ deltaY := deltaY + nextEvent fourth].
- modifiers := evtBuf fifth.
- buttons := (modifiers bitShift: 3) bitOr: (lastMouseEvent buttons bitAnd: 7).
^ MouseWheelEvent new
setType: #mouseWheel
position: self position
delta: deltaX@deltaY
- direction: 2r0000
buttons: buttons
hand: self
stamp: stamp!

Item was changed:
----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
handleEvent: unfilteredEvent

| filteredEvent |
owner ifNil: [^ unfilteredEvent "not necessary but good style -- see Morph >> #handleEvent:"].

self logEvent: unfilteredEvent.

"Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].

self showEvent: unfilteredEvent.
self sendListenEvents: unfilteredEvent.

filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
"filteredEvent := unfilteredEvent" " <-- use="" this="" to="" disable="" global="" capture="">

filteredEvent wasIgnored ifTrue: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isWindowEvent ifTrue: [
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isKeyboard ifTrue:[
self sendKeyboardEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isDropEvent ifTrue:[
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMouse ifFalse: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

" ********** MOUSE EVENT *********** "

lastMouseEvent := filteredEvent.

"Check for pending drag or double click operations."
mouseClickState ifNotNil:[
(mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
"Possibly dispatched #click: or something and will not re-establish otherwise"
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent]].

filteredEvent isMouseWheel ifTrue: [
+ self class sendMouseWheelToKeyboardFocus
+ ifFalse: [self sendMouseEvent: filteredEvent]
+ ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
- mouseWheelState ifNil: [mouseWheelState := MouseWheelState new].
- mouseWheelState handleEvent: filteredEvent from: self.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMove ifTrue:[
self position: filteredEvent position.
self sendMouseEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

"Issue a synthetic move event if we're not at the position of the event"
filteredEvent position = self position
ifFalse: [self moveToEvent: filteredEvent].

"Drop submorphs on button events"
self hasSubmorphs
ifTrue:[self dropMorphs: filteredEvent]
ifFalse:[self sendMouseEvent: filteredEvent].

self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !

Item was added:
+ ----- Method: MouseWheelEvent>>setDirection (in category 'initialization') -----
+ setDirection
+ delta x > 0 ifTrue: [self setWheelRight].
+ delta x < 0="" iftrue:="" [self="">
+
+ delta y > 0 ifTrue: [self setWheelUp].
+ delta y < 0="" iftrue:="" [self="">

Item was added:
+ ----- Method: MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category 'private') -----
+ setType: evtType position: evtPos delta: evtDelta buttons: evtButtons hand: evtHand stamp: stamp
+ type := evtType.
+ position := evtPos.
+ buttons := evtButtons.
+ source := evtHand.
+ wasHandled := false.
+ direction := 2r0000.
+ delta := evtDelta.
+ timeStamp := stamp.
+ self setDirection!

Item was removed:
- Object subclass: #MouseWheelState
- instanceVariableNames: 'currentDelta'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!

Item was removed:
- ----- Method: MouseWheelState>>handleEvent:from: (in category 'event processing') -----
- handleEvent: aMouseWheelEvent from: aHand
- "Every 120 units, raise the wheel flags for convenient mouse wheel programming. We choose not to send multiple mouse-wheel events for multiples of 120 because applications can always react to the actual delta values if they want to do more scrolling or zooming."
-
- | sign |
- currentDelta := currentDelta + aMouseWheelEvent wheelDelta.
-
- sign := currentDelta sign.
- currentDelta := currentDelta abs.
-
- (currentDelta x // 120) > 0 ifTrue: [
- sign x = 1
- ifTrue: [aMouseWheelEvent setWheelRight]
- ifFalse: [aMouseWheelEvent setWheelLeft]].
-
- (currentDelta y // 120) > 0 ifTrue: [
- sign y = 1
- ifTrue: [aMouseWheelEvent setWheelUp]
- ifFalse: [aMouseWheelEvent setWheelDown]].
-
- currentDelta := currentDelta \\ 120.
- currentDelta := currentDelta * sign.
-
- "Finally, send the event."
- HandMorph sendMouseWheelToKeyboardFocus
- ifFalse: [aHand sendMouseEvent: aMouseWheelEvent]
- ifTrue: [aHand sendEvent: aMouseWheelEvent focus: aHand keyboardFocus clear: [aHand keyboardFocus: nil]].
- !

Item was removed:
- ----- Method: MouseWheelState>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
- currentDelta := 0@0.!

Item was changed:
----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
mouseWheel: evt

+ evt isWheelUp ifTrue: [scrollBar scrollUp: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelDown ifTrue: [scrollBar scrollDown: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelLeft ifTrue: [hScrollBar scrollUp: (3 * evt wheelDelta x abs // 120 max: 1)].
+ evt isWheelRight ifTrue: [hScrollBar scrollDown: (3 * evt wheelDelta x abs // 120 max: 1)].!
- evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
- evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!





Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-nice.1613.mcz

Nicolas Cellier


Le lun. 6 janv. 2020 à 14:37, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas.

IMO, global mouse wheel state serves  just complexifies things uselessly.

Not global. Local to a hand. There can be multiple hands in an image.

So -1 for a Preferences, this is not a Preferences, this is a must, or we will never switch to sendMouseWheelEvents

Agreed. :-)

Also, smooth wheel scrolling is related to some magic numbers in PluggableTextMorph and ScrollPane (or ScrollBar). In any case an issue for after the 5.3 release. I suppose.

Best,
Marcel

Indeed, magic numbers just show how experimental (young) the code is.
This can wait a few more weeks, the important thing is that we get the updated VM.

Am 06.01.2020 14:10:54 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
this is the pragmatical result of experimentation.
Please try such a configuration:
- a VM that sends mouse wheel events
- Smalltalk sendMouseWheelEvents: true
- a computer with a trackpad (preferably a MacBook which sends many many such events)

So -1 for a Preferences, this is not a Preferences, this is a must, or we will never switch to sendMouseWheelEvents

Concerning peekEvent, sorry, I don't understand the problem.
I used the exact same solution than HandMorph>>mouseTrailFrom: (from #generateMouseEvent:)
If we send #peekEvent at every #mouseMove we can also send it at every mouse wheel.

IMO, global mouse wheel state serves  just complexifies things uselessly.
We don't want a global state (Or is it for MVC?)

Le lun. 6 janv. 2020 à 13:46, Marcel Taeumel <[hidden email]> a écrit :
Hmm... so you want to move any delta aggregation into the VM but keep delta-to-event mapping inside the image. In a perfect world, this would be the way to go. But the use of "Sensor peekEvent" is really, really, really unfortunate! :-) I would try to remove it the next time I stumble over it. :-D Sorry.

Considering cross-platform VM issues in the past, I would rather not remove the delta aggregation (or delta mapping) from the image. MouseWheelState took inspiration from MouseClickState and MouseOverHandler.

So, I vote for:

- make delta aggregation (or mapping) optional in the image via a preference
- add that time-out to MouseWheelState
- no calls to "Sensor peekEvent" in HandMorph under any circumstances ... please :-)

Best,
Marcel

Am 27.12.2019 22:58:16 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-nice.1613.mcz

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

Name: Morphic-nice.1613
Author: nice
Time: 27 December 2019, 10:57:36.813907 pm
UUID: 07043442-aa16-4af4-9123-601cd503346a
Ancestors: Morphic-mt.1612

Provide smoother scrolling in response to mouse wheel events

Instead of delivering the events when delta reaches 120, make this threshold a Preference (minimumWheelDelta)

Reminder: 120 represents a single notch for traditional mouse wheel with notches, but trackpads can deliver much smaller deltas

Rather than accumulating the deltas into MouseWheelState, do it when we #generateMouseWheelEvent:
Indeed, small deltas will come in packets of successive events, and it's more efficient to regroup then, a bit like we do with mouse trails...

Also MouseWheelState did ignore time outs (long delays between deltas) and other state changes (buttons/modifiers), which was not ideal.

Directly get those states from the raw eventBuffer, like any other mouse event. This requires integration of tose 2 PR:
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/461 for Windows
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/462 for OSX and linux

Honour larger deltas too in ScrollPane>>#mouseWheel: event handling
Honour horizontal mouse wheels too in ScrollPane

With patched VM, and following settings, I get a reasonnable scrolling experience on OSX:

HandMorph minimumWheelDelta: 20.
Smalltalk sendMouseWheelEvents: true.

=============== Diff against Morphic-mt.1612 ===============

Item was changed:
Morph subclass: #HandMorph
instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler mouseWheelState lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
+ classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
poolDictionaries: 'EventSensorConstants'
category: 'Morphic-Kernel'!

!HandMorph commentStamp: '' prior: 0!
The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging.

There is some minimal support for multiple hands in the same world.!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta (in category 'preferences') -----
+ minimumWheelDelta
+
+ categoryList: #(Morphic mouse)
+ description: 'Answer the minimal scroll increment taken into account
+ Defaults to 120, corresponding to a single mouse wheel notch.
+ Use a lower value (20) if wanting smoother scrolling with trackpads.'
+ type: #Number>
+ ^MinimalWheelDelta ifNil: [120].!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta: (in category 'preferences') -----
+ minimumWheelDelta: anInteger
+ MinimalWheelDelta := anInteger ifNotNil: [anInteger clampLow: 20 high: 120]!

Item was changed:
----- Method: HandMorph>>generateMouseWheelEvent: (in category 'private events') -----
generateMouseWheelEvent: evtBuf
"Generate the appropriate mouse wheel event for the given raw event buffer"

+ | buttons modifiers deltaX deltaY stamp nextEvent |
- | buttons modifiers deltaX deltaY stamp |
stamp := evtBuf second.
stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
deltaX := evtBuf third.
deltaY := evtBuf fourth.
+ buttons := evtBuf fifth.
+ modifiers := evtBuf sixth.
+ [(deltaX abs + deltaY abs < self="" class="">
+ and: [(nextEvent := Sensor peekEvent) notNil
+ and: [nextEvent first = evtBuf first
+ and: [nextEvent fifth = evtBuf fifth
+ and: [nextEvent sixth = evtBuf sixth]
+ and: [nextEvent third isZero = evtBuf third isZero "both horizontal or vertical"]]]]]
+ whileTrue:
+ ["nextEvent is similar. Remove it from the queue, and check the next."
+ nextEvent := Sensor nextEvent.
+ deltaX := deltaX + nextEvent third.
+ deltaY := deltaY + nextEvent fourth].
- modifiers := evtBuf fifth.
- buttons := (modifiers bitShift: 3) bitOr: (lastMouseEvent buttons bitAnd: 7).
^ MouseWheelEvent new
setType: #mouseWheel
position: self position
delta: deltaX@deltaY
- direction: 2r0000
buttons: buttons
hand: self
stamp: stamp!

Item was changed:
----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
handleEvent: unfilteredEvent

| filteredEvent |
owner ifNil: [^ unfilteredEvent "not necessary but good style -- see Morph >> #handleEvent:"].

self logEvent: unfilteredEvent.

"Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].

self showEvent: unfilteredEvent.
self sendListenEvents: unfilteredEvent.

filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
"filteredEvent := unfilteredEvent" " <-- use="" this="" to="" disable="" global="" capture="">

filteredEvent wasIgnored ifTrue: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isWindowEvent ifTrue: [
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isKeyboard ifTrue:[
self sendKeyboardEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isDropEvent ifTrue:[
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMouse ifFalse: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

" ********** MOUSE EVENT *********** "

lastMouseEvent := filteredEvent.

"Check for pending drag or double click operations."
mouseClickState ifNotNil:[
(mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
"Possibly dispatched #click: or something and will not re-establish otherwise"
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent]].

filteredEvent isMouseWheel ifTrue: [
+ self class sendMouseWheelToKeyboardFocus
+ ifFalse: [self sendMouseEvent: filteredEvent]
+ ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
- mouseWheelState ifNil: [mouseWheelState := MouseWheelState new].
- mouseWheelState handleEvent: filteredEvent from: self.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMove ifTrue:[
self position: filteredEvent position.
self sendMouseEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

"Issue a synthetic move event if we're not at the position of the event"
filteredEvent position = self position
ifFalse: [self moveToEvent: filteredEvent].

"Drop submorphs on button events"
self hasSubmorphs
ifTrue:[self dropMorphs: filteredEvent]
ifFalse:[self sendMouseEvent: filteredEvent].

self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !

Item was added:
+ ----- Method: MouseWheelEvent>>setDirection (in category 'initialization') -----
+ setDirection
+ delta x > 0 ifTrue: [self setWheelRight].
+ delta x < 0="" iftrue:="" [self="">
+
+ delta y > 0 ifTrue: [self setWheelUp].
+ delta y < 0="" iftrue:="" [self="">

Item was added:
+ ----- Method: MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category 'private') -----
+ setType: evtType position: evtPos delta: evtDelta buttons: evtButtons hand: evtHand stamp: stamp
+ type := evtType.
+ position := evtPos.
+ buttons := evtButtons.
+ source := evtHand.
+ wasHandled := false.
+ direction := 2r0000.
+ delta := evtDelta.
+ timeStamp := stamp.
+ self setDirection!

Item was removed:
- Object subclass: #MouseWheelState
- instanceVariableNames: 'currentDelta'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!

Item was removed:
- ----- Method: MouseWheelState>>handleEvent:from: (in category 'event processing') -----
- handleEvent: aMouseWheelEvent from: aHand
- "Every 120 units, raise the wheel flags for convenient mouse wheel programming. We choose not to send multiple mouse-wheel events for multiples of 120 because applications can always react to the actual delta values if they want to do more scrolling or zooming."
-
- | sign |
- currentDelta := currentDelta + aMouseWheelEvent wheelDelta.
-
- sign := currentDelta sign.
- currentDelta := currentDelta abs.
-
- (currentDelta x // 120) > 0 ifTrue: [
- sign x = 1
- ifTrue: [aMouseWheelEvent setWheelRight]
- ifFalse: [aMouseWheelEvent setWheelLeft]].
-
- (currentDelta y // 120) > 0 ifTrue: [
- sign y = 1
- ifTrue: [aMouseWheelEvent setWheelUp]
- ifFalse: [aMouseWheelEvent setWheelDown]].
-
- currentDelta := currentDelta \\ 120.
- currentDelta := currentDelta * sign.
-
- "Finally, send the event."
- HandMorph sendMouseWheelToKeyboardFocus
- ifFalse: [aHand sendMouseEvent: aMouseWheelEvent]
- ifTrue: [aHand sendEvent: aMouseWheelEvent focus: aHand keyboardFocus clear: [aHand keyboardFocus: nil]].
- !

Item was removed:
- ----- Method: MouseWheelState>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
- currentDelta := 0@0.!

Item was changed:
----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
mouseWheel: evt

+ evt isWheelUp ifTrue: [scrollBar scrollUp: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelDown ifTrue: [scrollBar scrollDown: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelLeft ifTrue: [hScrollBar scrollUp: (3 * evt wheelDelta x abs // 120 max: 1)].
+ evt isWheelRight ifTrue: [hScrollBar scrollDown: (3 * evt wheelDelta x abs // 120 max: 1)].!
- evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
- evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!






Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-nice.1613.mcz

Nicolas Cellier


Le lun. 6 janv. 2020 à 14:50, Nicolas Cellier <[hidden email]> a écrit :


Le lun. 6 janv. 2020 à 14:37, Marcel Taeumel <[hidden email]> a écrit :
Hi Nicolas.

IMO, global mouse wheel state serves  just complexifies things uselessly.

Not global. Local to a hand. There can be multiple hands in an image.

So -1 for a Preferences, this is not a Preferences, this is a must, or we will never switch to sendMouseWheelEvents

Agreed. :-)

Also, smooth wheel scrolling is related to some magic numbers in PluggableTextMorph and ScrollPane (or ScrollBar). In any case an issue for after the 5.3 release. I suppose.

Best,
Marcel

Indeed, magic numbers just show how experimental (young) the code is.
This can wait a few more weeks, the important thing is that we get the updated VM.

However, the magic numbers 3 and 120 were aready spreaded in the code, it's just that I linked the two of them.

We could have these definitions:

MouseWheelEvent class<<scrollingUnitsPerMouseWheelNotch
    "Return the number of scrolling units per single mouse wheel notch.
    This number is encoded in the VM.
    Devices not having notch (like trackpad) may deliver events with smaller deltas.
    Thus, providing a value high enough enables smoother scrolling on those devices while keeping Integer arithmetic.
    Note that interpretation of scrolling units is left to the clients.
    Typically, a single wheel notch accounts for a scroll of 3 lines of Text."
    ^120

ScrollPane class<<numberOfScrollingIncrementsPerMouseWheelNotch
    "Return the number of scrolling increment per mouse wheel notch.
    a scrolling increment is typically a text line for list and text panes (see scrollDelta).
    The default value of 3 lines per mouse wheel is typically used in many applications outside Squeak."
    ^NumberOfScrollingIncrementsPerMouseWheelNotch ifNil: [3]

Then, we could implement the conversion like this:

MouseWheelEvent class<<convertWheelDelta: scrollingUnits intoScrollIncrements: scrollIncrementPerWheelNotch
    "convert the wheel delta provided by the VM in scrolling units,
    into a number of scrolling increments known to the scroll pane"

   ^scrollIncrementPerWheelNotch * scrollingUnits // self scrollingUnitsPerMouseWheelNotch max: 1

possibly with shorter names ;)


Am 06.01.2020 14:10:54 schrieb Nicolas Cellier <[hidden email]>:

Hi Marcel,
this is the pragmatical result of experimentation.
Please try such a configuration:
- a VM that sends mouse wheel events
- Smalltalk sendMouseWheelEvents: true
- a computer with a trackpad (preferably a MacBook which sends many many such events)

So -1 for a Preferences, this is not a Preferences, this is a must, or we will never switch to sendMouseWheelEvents

Concerning peekEvent, sorry, I don't understand the problem.
I used the exact same solution than HandMorph>>mouseTrailFrom: (from #generateMouseEvent:)
If we send #peekEvent at every #mouseMove we can also send it at every mouse wheel.

IMO, global mouse wheel state serves  just complexifies things uselessly.
We don't want a global state (Or is it for MVC?)

Le lun. 6 janv. 2020 à 13:46, Marcel Taeumel <[hidden email]> a écrit :
Hmm... so you want to move any delta aggregation into the VM but keep delta-to-event mapping inside the image. In a perfect world, this would be the way to go. But the use of "Sensor peekEvent" is really, really, really unfortunate! :-) I would try to remove it the next time I stumble over it. :-D Sorry.

Considering cross-platform VM issues in the past, I would rather not remove the delta aggregation (or delta mapping) from the image. MouseWheelState took inspiration from MouseClickState and MouseOverHandler.

So, I vote for:

- make delta aggregation (or mapping) optional in the image via a preference
- add that time-out to MouseWheelState
- no calls to "Sensor peekEvent" in HandMorph under any circumstances ... please :-)

Best,
Marcel

Am 27.12.2019 22:58:16 schrieb [hidden email] <[hidden email]>:

Nicolas Cellier uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-nice.1613.mcz

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

Name: Morphic-nice.1613
Author: nice
Time: 27 December 2019, 10:57:36.813907 pm
UUID: 07043442-aa16-4af4-9123-601cd503346a
Ancestors: Morphic-mt.1612

Provide smoother scrolling in response to mouse wheel events

Instead of delivering the events when delta reaches 120, make this threshold a Preference (minimumWheelDelta)

Reminder: 120 represents a single notch for traditional mouse wheel with notches, but trackpads can deliver much smaller deltas

Rather than accumulating the deltas into MouseWheelState, do it when we #generateMouseWheelEvent:
Indeed, small deltas will come in packets of successive events, and it's more efficient to regroup then, a bit like we do with mouse trails...

Also MouseWheelState did ignore time outs (long delays between deltas) and other state changes (buttons/modifiers), which was not ideal.

Directly get those states from the raw eventBuffer, like any other mouse event. This requires integration of tose 2 PR:
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/461 for Windows
https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/462 for OSX and linux

Honour larger deltas too in ScrollPane>>#mouseWheel: event handling
Honour horizontal mouse wheels too in ScrollPane

With patched VM, and following settings, I get a reasonnable scrolling experience on OSX:

HandMorph minimumWheelDelta: 20.
Smalltalk sendMouseWheelEvents: true.

=============== Diff against Morphic-mt.1612 ===============

Item was changed:
Morph subclass: #HandMorph
instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler mouseWheelState lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
+ classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
poolDictionaries: 'EventSensorConstants'
category: 'Morphic-Kernel'!

!HandMorph commentStamp: '' prior: 0!
The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging.

There is some minimal support for multiple hands in the same world.!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta (in category 'preferences') -----
+ minimumWheelDelta
+
+ categoryList: #(Morphic mouse)
+ description: 'Answer the minimal scroll increment taken into account
+ Defaults to 120, corresponding to a single mouse wheel notch.
+ Use a lower value (20) if wanting smoother scrolling with trackpads.'
+ type: #Number>
+ ^MinimalWheelDelta ifNil: [120].!

Item was added:
+ ----- Method: HandMorph class>>minimumWheelDelta: (in category 'preferences') -----
+ minimumWheelDelta: anInteger
+ MinimalWheelDelta := anInteger ifNotNil: [anInteger clampLow: 20 high: 120]!

Item was changed:
----- Method: HandMorph>>generateMouseWheelEvent: (in category 'private events') -----
generateMouseWheelEvent: evtBuf
"Generate the appropriate mouse wheel event for the given raw event buffer"

+ | buttons modifiers deltaX deltaY stamp nextEvent |
- | buttons modifiers deltaX deltaY stamp |
stamp := evtBuf second.
stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
deltaX := evtBuf third.
deltaY := evtBuf fourth.
+ buttons := evtBuf fifth.
+ modifiers := evtBuf sixth.
+ [(deltaX abs + deltaY abs < self="" class="">
+ and: [(nextEvent := Sensor peekEvent) notNil
+ and: [nextEvent first = evtBuf first
+ and: [nextEvent fifth = evtBuf fifth
+ and: [nextEvent sixth = evtBuf sixth]
+ and: [nextEvent third isZero = evtBuf third isZero "both horizontal or vertical"]]]]]
+ whileTrue:
+ ["nextEvent is similar. Remove it from the queue, and check the next."
+ nextEvent := Sensor nextEvent.
+ deltaX := deltaX + nextEvent third.
+ deltaY := deltaY + nextEvent fourth].
- modifiers := evtBuf fifth.
- buttons := (modifiers bitShift: 3) bitOr: (lastMouseEvent buttons bitAnd: 7).
^ MouseWheelEvent new
setType: #mouseWheel
position: self position
delta: deltaX@deltaY
- direction: 2r0000
buttons: buttons
hand: self
stamp: stamp!

Item was changed:
----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
handleEvent: unfilteredEvent

| filteredEvent |
owner ifNil: [^ unfilteredEvent "not necessary but good style -- see Morph >> #handleEvent:"].

self logEvent: unfilteredEvent.

"Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].

self showEvent: unfilteredEvent.
self sendListenEvents: unfilteredEvent.

filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
"filteredEvent := unfilteredEvent" " <-- use="" this="" to="" disable="" global="" capture="">

filteredEvent wasIgnored ifTrue: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isWindowEvent ifTrue: [
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isKeyboard ifTrue:[
self sendKeyboardEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isDropEvent ifTrue:[
self sendEvent: filteredEvent focus: nil.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMouse ifFalse: [
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

" ********** MOUSE EVENT *********** "

lastMouseEvent := filteredEvent.

"Check for pending drag or double click operations."
mouseClickState ifNotNil:[
(mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
"Possibly dispatched #click: or something and will not re-establish otherwise"
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent]].

filteredEvent isMouseWheel ifTrue: [
+ self class sendMouseWheelToKeyboardFocus
+ ifFalse: [self sendMouseEvent: filteredEvent]
+ ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
- mouseWheelState ifNil: [mouseWheelState := MouseWheelState new].
- mouseWheelState handleEvent: filteredEvent from: self.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

filteredEvent isMove ifTrue:[
self position: filteredEvent position.
self sendMouseEvent: filteredEvent.
self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent].

"Issue a synthetic move event if we're not at the position of the event"
filteredEvent position = self position
ifFalse: [self moveToEvent: filteredEvent].

"Drop submorphs on button events"
self hasSubmorphs
ifTrue:[self dropMorphs: filteredEvent]
ifFalse:[self sendMouseEvent: filteredEvent].

self mouseOverHandler processMouseOver: lastMouseEvent.
^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !

Item was added:
+ ----- Method: MouseWheelEvent>>setDirection (in category 'initialization') -----
+ setDirection
+ delta x > 0 ifTrue: [self setWheelRight].
+ delta x < 0="" iftrue:="" [self="">
+
+ delta y > 0 ifTrue: [self setWheelUp].
+ delta y < 0="" iftrue:="" [self="">

Item was added:
+ ----- Method: MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category 'private') -----
+ setType: evtType position: evtPos delta: evtDelta buttons: evtButtons hand: evtHand stamp: stamp
+ type := evtType.
+ position := evtPos.
+ buttons := evtButtons.
+ source := evtHand.
+ wasHandled := false.
+ direction := 2r0000.
+ delta := evtDelta.
+ timeStamp := stamp.
+ self setDirection!

Item was removed:
- Object subclass: #MouseWheelState
- instanceVariableNames: 'currentDelta'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!

Item was removed:
- ----- Method: MouseWheelState>>handleEvent:from: (in category 'event processing') -----
- handleEvent: aMouseWheelEvent from: aHand
- "Every 120 units, raise the wheel flags for convenient mouse wheel programming. We choose not to send multiple mouse-wheel events for multiples of 120 because applications can always react to the actual delta values if they want to do more scrolling or zooming."
-
- | sign |
- currentDelta := currentDelta + aMouseWheelEvent wheelDelta.
-
- sign := currentDelta sign.
- currentDelta := currentDelta abs.
-
- (currentDelta x // 120) > 0 ifTrue: [
- sign x = 1
- ifTrue: [aMouseWheelEvent setWheelRight]
- ifFalse: [aMouseWheelEvent setWheelLeft]].
-
- (currentDelta y // 120) > 0 ifTrue: [
- sign y = 1
- ifTrue: [aMouseWheelEvent setWheelUp]
- ifFalse: [aMouseWheelEvent setWheelDown]].
-
- currentDelta := currentDelta \\ 120.
- currentDelta := currentDelta * sign.
-
- "Finally, send the event."
- HandMorph sendMouseWheelToKeyboardFocus
- ifFalse: [aHand sendMouseEvent: aMouseWheelEvent]
- ifTrue: [aHand sendEvent: aMouseWheelEvent focus: aHand keyboardFocus clear: [aHand keyboardFocus: nil]].
- !

Item was removed:
- ----- Method: MouseWheelState>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
- currentDelta := 0@0.!

Item was changed:
----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
mouseWheel: evt

+ evt isWheelUp ifTrue: [scrollBar scrollUp: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelDown ifTrue: [scrollBar scrollDown: (3 * evt wheelDelta y abs // 120 max: 1)].
+ evt isWheelLeft ifTrue: [hScrollBar scrollUp: (3 * evt wheelDelta x abs // 120 max: 1)].
+ evt isWheelRight ifTrue: [hScrollBar scrollDown: (3 * evt wheelDelta x abs // 120 max: 1)].!
- evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
- evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!