[Cuis-dev] [RFC] True Mouse Wheel Support
Gerald Klix
cuis.01 at klix.ch
Thu Aug 12 13:20:36 PDT 2021
Hi all, Hi Phil,
Please find attached a preliminary version of my mouse-wheel support
code. Please review the coding style and check for any errors.
I only tested it on Linux 64bit, but will also
test on Windows tomorrow.
The code needs `Smalltalk sendMouseWheelEvents: true` to be active.
Vertical scrolling should be smoother/slower,
horizontal scrolling should work.
Have Fun and Best Regards,
Gerald
On 8/11/21 11:07 PM, Gerald Klix via Cuis-dev wrote:
> Hoi Phil,
>
> On 8/11/21 10:31 PM, Phil B via Cuis-dev wrote:
>> Gerald,
>>
>> I implemented the wheel event support for Cuis anticipating that at some
>> point in the future we'd be able to get 'uncooked' events from the VM.
> Cool!
>> So
>> if you see a way to get them, by all means please do so.
> You won't believe it, its dead simple, just copy this SystemDirectory
> method from Squeak
>
> --- snip ---
> sendMouseWheelEvents: aBoolean
> "The Cog VM can be instructed to deliver mouse wheel events as
> mouse wheel events.
> By default mouse wheel events are mapped to arrow events.
> This flag persists across snapshots, stored in the image header."
>
> self vmParameterAt: 48 put: ((self vmParameterAt: 48) bitClear: 32)
> + (aBoolean ifTrue: [32] ifFalse: [0])
> --- snap ---
>
> and send the apropriate message.
>
> I verified this behavior by dumping the events with `Sensor test` on a
> Linux 64-bit VM. The VM sends events of type 7.
>
>> It's been a few
>> years, but the last time I looked the Unix VM didn't have it yet. IIRC,
>> only one platform (Windows?) did and *all* VM platforms need to
>> support it
>> before you can flip the switch on the functionality.
>
> I discovered this feature accidentally, while looking at the X11 code;
> I wanted all buttons of my trackball supported, some more modifier keys.
>
> I now see the problem (vm/platforms):
> >>> find -name '*.c'| xargs grep sendWheelEvents
>
> yields:
>
> ./win32/vm/sqWin32Window.c:extern sqInt sendWheelEvents; /* If true
> deliver EventTypeMouseWheel else kybd */
> ./win32/vm/sqWin32Window.c:/* if sendWheelEvents is false this maps
> wheel events to arrow keys */
> ./win32/vm/sqWin32Window.c: if (inputSemaphoreIndex &&
> sendWheelEvents) {
> ./win32/vm/sqWin32Window.c: if (sendWheelEvents) {
> ./unix/vm-display-X11/sqUnixX11.c:extern sqInt sendWheelEvents; /* If
> true deliver EventTypeMouseWheel else kybd */
> ./unix/vm-display-X11/sqUnixX11.c:/* if sendWheelEvents is false this
> maps wheel events to arrow keys */
> ./unix/vm-display-X11/sqUnixX11.c:/* if sendWheelEvents is true this
> determines how much x & y are incremented */
> ./unix/vm-display-X11/sqUnixX11.c: if (sendWheelEvents)
> ./unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c:extern sqInt
> sendWheelEvents; /* If true deliver EventTypeMouseWheel else kybd */
> ./unix/vm-display-fbdev/sqUnixEvdevKeyMouse.c: if (sendWheelEvents) {
>
>
> In this case the old code needs to remain for the unsupported OSes.
>
> It's now 11pm here, I will look into it tomorrow.
>
>
> Best Regards,
>
> Gerald
>
>
>>
>> Thanks,
>> Phil
>>
>> On Wed, Aug 11, 2021, 3:02 PM Gerald Klix via Cuis-dev <
>> cuis-dev at lists.cuis.st> wrote:
>>
>>> I just noticed that all the events and processing methods are there.
>>> I searched for '*Wheel*' instead of '*Scroll*'.
>>>
>>>
>>>
>>> On 8/11/21 8:46 PM, Gerald Klix via Cuis-dev wrote:
>>>> Hi all, Hi Juan,
>>>>
>>>> Is there interest in implementing or porting *true*
>>>> mouse wheel support for/to Cuis?
>>>> I mean switching off the up/down-key emulation
>>>> in the VM and add the necessary event classes
>>>> and processing methods.
>>>>
>>>> Benefits:
>>>> Mouses with a tilting wheel -- wheel left/right -- will be supported.
>>>>
>>>> I would like to see all of the keys my Elecom trackballs
>>>> provide supported, alas this will require patching the VM.
>>>> Maybe I will change the VM's X11 code.
>>>>
>>>>
>>>> Best Regards,
>>>>
>>>> Gerald
>>>>
>>>>
>>>> Trackball images:
>>>> https://i.ebayimg.com/images/i/272219997851-0-1/s-l1000.jpg
>>>> https://i.ebayimg.com/images/g/wWAAAOSwB5Fe5vK-/s-l640.jpg
>>> --
>>> Cuis-dev mailing list
>>> Cuis-dev at lists.cuis.st
>>> https://lists.cuis.st/mailman/listinfo/cuis-dev
>>>
>>
>>
-------------- next part --------------
'From Haver 5.0 [latest update: #4743] on 12 August 2021 at 10:11:31 pm'!
!EventSensor methodsFor: 'private-I/O' stamp: 'KLG 8/12/2021 20:23:55'!
processMouseSensorWheelEvent: evt
"Process a mouse wheel event, updating EventSensor state.
Ported from Squeak 5.3."
| modifiers buttons mapped |
"Only used by #peekWheelDelta in Squeak, which has no senders.
Can be added in the future."
"F: mouseWheelDelta := (evt at: 3) @ (evt at: 4)."
buttons _ evt at: 5.
modifiers _ evt at: 6.
mapped _ self mapButtons: buttons modifiers: modifiers.
mouseButtons _ mapped bitOr: (modifiers bitShift: 3).! !
!EventSensor class methodsFor: 'constants' stamp: 'KLG 8/12/2021 21:58:09'!
eventTypeMouseScroll
"Types of events,
I am a mouse wheel event."
^7! !
!SystemDictionary methodsFor: 'vm parameters' stamp: 'KLG 8/12/2021 18:50:26'!
sendMouseWheelEvents
"The Cog VM can be instructed to deliver mouse wheel events as mouse wheel events.
By default mouse wheel events are mapped to arrow events.
This flag persists across snapshots, stored in the image header.
This implementation was copied from Squeak 5.3."
^(self vmParameterAt: 48) anyMask: 32! !
!SystemDictionary methodsFor: 'vm parameters' stamp: 'KLG 8/12/2021 18:50:12'!
sendMouseWheelEvents: aBoolean
"The Cog VM can be instructed to deliver mouse wheel events as mouse wheel events.
By default mouse wheel events are mapped to arrow events.
This flag persists across snapshots, stored in the image header.
This implementation was copied from Squeak 5.3."
self vmParameterAt: 48 put: ((self vmParameterAt: 48) bitClear: 32) + (aBoolean ifTrue: [32] ifFalse: [0])! !
!HandMorph methodsFor: 'private events' stamp: 'KLG 8/12/2021 21:54:40'!
generateMouseScrollEvent: evtBuf
"Generate the appropriate mouse wheel event for the given raw event buffer
Copied from Sqeak 5.3 and modifed."
| buttons modifiers stamp deltaX deltaY direction |
stamp _ evtBuf second.
stamp = 0 ifTrue: [stamp := Time millisecondClockValue ].
deltaX _ evtBuf third.
deltaY _ evtBuf fourth.
"This implementation deliberatly ignores movements in both dimensions:"
direction _
deltaY negative
ifTrue: [ #down ]
ifFalse: [ deltaY strictlyPositive
ifTrue: [ #up ]
ifFalse: [ deltaX negative
ifTrue: [ #left ]
ifFalse: [ deltaX strictlyPositive
ifTrue: [ #right ]
ifFalse: [ ^ nil "No movement, bailing out" ] ] ] ].
modifiers _ evtBuf fifth.
buttons _ (modifiers bitShift: 3) bitOr: (lastMouseEvent buttons bitAnd: 7).
^ MouseScrollEvent new
setType: #mouseScroll
position: self morphPosition
direction: direction
buttons: buttons
hand: self
stamp: stamp! !
!EventSensor methodsFor: 'private-I/O' stamp: 'KLG 8/12/2021 21:58:09'!
processSensorEvent: evt discardingMouseEvents: discardMouseEvents
"Process a single event. This method is run at high priority."
| type |
type _ evt at: 1.
"Check if the event is a user interrupt"
(type = EventSensor eventTypeKeyboard and: [ (evt at: 4) = 0 and: [
((evt at: 3) bitOr: (((evt at: 5) bitAnd: 8) bitShift: 8)) = interruptKey]])
ifTrue: [
"interrupt key is meta - not reported as event"
^interruptSemaphore signal].
"Store the event in the queue if there's any"
type = EventSensor eventTypeMouse ifTrue: [
"Only swap secondary and tertiary buttons if there is no command or option modifier keys.
This swap is done so a 3-button mouse is
left -> mouseButton1 (select)
center -> mouseButton3 (halo)
right -> mouseButton2 (menu).
This is only needed on the Mac, Window VM does this mapping by default.
We avoid ding the swap if there are modifier keys, because in that case the buttons were generated by the VM as follows:
left -> mouseButton1
macOption + left -> mouseButton3
command + left -> mouseButton2,
but Mac users are already used to
macOption + left -> menu
command + left -> halo.
See #installMouseDecodeTable"
((evt at: 6) anyMask: 12) ifFalse: [
evt at: 5 put: (ButtonDecodeTable at: (evt at: 5) + 1)]].
(discardMouseEvents and: [ type = EventSensor eventTypeMouse ]) ifFalse: [
self queueEvent: evt ].
"Update state for InputSensor."
"KLG: Why not `self class` instead of `EventSensor`?"
type = EventSensor eventTypeMouse ifTrue: [
self processMouseSensorEvent: evt ].
type = EventSensor eventTypeKeyboard ifTrue: [
self processKeyboardSensorEvent: evt ].
type = EventSensor eventTypeMouseScroll ifTrue: [
self processMouseSensorWheelEvent: evt ]! !
!EventSensor methodsFor: 'test' stamp: 'KLG 8/12/2021 22:08:17'!
printEventBuffer: evtBuf
| type buttons macRomanCode modifiers pressType stamp unicodeCodePoint |
type _ evtBuf first.
stamp _ evtBuf second.
stamp = 0 ifTrue: [ stamp := Time millisecondClockValue ]. "VMs report events using #millisecondClockValue"
type = EventSensor eventTypeMouse
ifTrue: [ | position |
position _ evtBuf third @ evtBuf fourth.
buttons _ evtBuf fifth.
modifiers _ evtBuf sixth.
Transcript
newLine;
show: 'Mouse';
show: ' position:', position printString;
show: ' buttons:', buttons printString;
show: ' modifiers:', modifiers printString.
].
type = EventSensor eventTypeMouseScroll
ifTrue: [ | delta |
delta _ evtBuf third @ evtBuf fourth.
buttons _ evtBuf fifth.
modifiers _ evtBuf sixth.
Transcript
newLine;
show: 'Scroll';
show: ' delta:', delta printString;
show: ' buttons:', buttons printString;
show: ' modifiers:', modifiers printString.
].
type = EventSensor eventTypeKeyboard
ifTrue: [
macRomanCode _ evtBuf third.
unicodeCodePoint _ evtBuf sixth.
pressType _ evtBuf fourth.
modifiers _ evtBuf fifth.
pressType = EventSensor eventKeyDown ifTrue: [
type _ #keyDown].
pressType = EventSensor eventKeyUp ifTrue: [
type _ #keyUp].
pressType = EventSensor eventKeyChar ifTrue: [
type _ #keystroke].
Transcript
newLine;
show: type;
show: ' macRomanCode:', macRomanCode printString, '-',
(Character numericValue: (Character macRomanToLatin1: macRomanCode)) asString, '-';
show: ' unicodeCodePoint:', unicodeCodePoint printString.
(Character iso8859s15CodeForUnicodeCodePoint: unicodeCodePoint) ifNotNil: [ :latin15 |
Transcript show: '-', (Character numericValue: latin15) asString, '-' ].
Transcript
show: ' modifiers:', modifiers printString.
(modifiers anyMask: 8) ifTrue: [ Transcript show: ' [commandWinAlt]' ].
(modifiers anyMask: 4) ifTrue: [ Transcript show: ' [macOption]' ].
(modifiers anyMask: 2) ifTrue: [ Transcript show: ' [control]' ].
(modifiers anyMask: 1) ifTrue: [ Transcript show: ' [shift]' ].
].! !
!HandMorph methodsFor: 'event handling' stamp: 'KLG 8/12/2021 21:58:09'!
createEventFrom: eventBuffer ofType: type
type = EventSensor eventTypeMouse ifTrue: [ ^self generateMouseEvent: eventBuffer ].
type = EventSensor eventTypeMouseScroll ifTrue: [ ^self generateMouseScrollEvent: eventBuffer ].
type = EventSensor eventTypeKeyboard ifTrue: [ ^self generateKeyboardEvent: eventBuffer ].
type = EventSensor eventTypeWindow ifTrue: [ ^self generateWindowEvent: eventBuffer ].
type = EventSensor eventTypeDragDropFiles ifTrue: [ ^self generateDropFilesEvent: eventBuffer ].
"All other events are ignored"
^nil ! !
!EventSensor reorganize!
('accessing' eventTicklerProcess flushAllButDandDEvents flushEvents nextEvent peekButtons peekEvent peekMousePt peekPosition)
('mouse' createMouseEvent)
('private' eventTickler flushNonKbdEvents installEventTickler isKbdEvent: lastEventPoll primInterruptSemaphore: primKbdNext primKbdPeek primMouseButtons primMousePt primSetInterruptKey:)
('private-I/O' fetchMoreEvents fetchMoreEventsDiscardingMouseEvents: mapButtons:modifiers: primGetNextEvent: primSetInputSemaphore: processKeyboardSensorEvent: processMouseSensorEvent: processMouseSensorWheelEvent: processSensorEvent:discardingMouseEvents: queueEvent:)
('test' printEventBuffer: test)
('initialization' initialize shutDownSensor)
!
!HandMorph reorganize!
('accessing' lastMouseEvent lastMouseEventTime mouseOverHandler)
('balloon help' balloonHelp balloonHelp: deleteBalloonTarget: removePendingBalloonFor: spawnBalloonFor: triggerBalloonFor:after:)
('caching' releaseCachedState)
('classification' is:)
('double click support' dontWaitForMoreClicks waitForClicksOrDrag:event:clkSel:dblClkSel: waitForClicksOrDrag:event:dragSel:clkSel: waitForClicksOrDragOrSimulatedMouseButton2:event:clkSel:clkNHalf:dblClkSel:dblClkNHalfSel:tripleClkSel: waitForClicksOrDragOrSimulatedMouseButton2:event:clkSel:clkNHalf:dblClkSel:dblClkNHalfSel:tripleClkSel:dragSel: waitingForMoreClicks)
('drawing' drawOn: fullDrawHandOn: needsToBeDrawn restoreSavedPatchOn: savePatchFrom:appendDamageTo:)
('event handling' createEventFrom:ofType: flushEvents noticeMouseOver:event: processEventQueue)
('events-processing' startDropEventDispatch: startDropFilesEventDispatch: startEventDispatch: startKeyboardDispatch: startMouseDispatch: startWindowEventDispatch:)
('focus handling' activateNextWindow activatePreviousWindow keyboardFocus keyboardFocusNext keyboardFocusPrevious mouseFocus newKeyboardFocus: newMouseFocus: nextFocusMorph nextFocusWindow previousFocusMorph previousFocusWindow releaseAllFoci releaseKeyboardFocus releaseKeyboardFocus: releaseMouseFocus releaseMouseFocus:)
('geometry' basicDisplayBounds displayFullBoundsForPatch)
('geometry testing' submorphsMightProtrude)
('grabbing/dropping' attachMorph: attachMorphBeside: dropMorph:event: dropMorphs: grabMorph: grabMorph:delta: grabMorph:moveUnderHand:)
('halo handling' halo: obtainHalo: releaseHalo: removeHaloFromClick:on:)
('halos and balloon help' halo)
('initialization' initForEvents initialize)
('testing' isIncludedInTaskbarDefault)
('objects from disk' objectForDataStream:)
('paste buffer' pasteMorph)
('updating')
('private' forgetGrabMorphDataFor: grabMorphDataFor: rememberGrabMorphDataFor:)
('private events' generateDropFilesEvent: generateKeyboardEvent: generateMouseEvent: generateMouseScrollEvent: generateWindowEvent: mouseTrailFrom: shouldControlEmulateAltFor:)
!
More information about the Cuis-dev
mailing list