EventHandler to detect key presses and mouse clicks

[Shardik]

A member of the German PureBasic forum wrote me a PM and asked me
for an example to detect key presses in an activated window much like
GetAsyncKeyState in Windows. I therefore extended one of my previous
examples that detects a left, right and middle button mouse click, to
also detect a key press and display the pressed key or clicked button:

Code: Select all

EnableExplicit

ImportC ""
  GetEventClass(Event)
EndImport

#kEventClassMouse = 'mous'
#kEventClassKeyboard = 'keyb'

#kEventMouseButtonPrimary = 1
#kEventMouseButtonSecondary = 2
#kEventMouseButtonTertiary = 3
#kEventMouseDown = 1

#kEventParamKeyMacCharCodes = 'kchr'
#kEventParamKeyModifiers = 'kmod'
#kEventParamMouseButton = 'mbtn'

#kEventRawKeyDown = 1

#typeChar = 'TEXT'
#typeMouseButton = 'mbtn'
#typeUInt32 = 'magn'

Structure EventTypeSpec
  EventClass.L
  EventKind.L
EndStructure

Define EventHandlerUPP.L

Procedure EventHandler(*NextEventHandler, Event.L, UserData.L)
  Protected ButtonType.L
  Protected KeyCode.L
  Protected KeyModifier.L

  Select GetEventClass(Event)
    Case #kEventClassMouse
      If GetEventParameter_(Event, #kEventParamMouseButton, #typeMouseButton, 0, 4, 0, @ButtonType) = 0
        If GetEventParameter_(Event, #kEventParamKeyModifiers, #typeUInt32, 0, 4, 0, @KeyModifier) = 0
          Select ButtonType
            Case #kEventMouseButtonPrimary
              If KeyModifier = $00001000
                SetGadgetText(1, "Right mouse button")
              Else
                SetGadgetText(1, "Left mouse button")
              EndIf
            Case #kEventMouseButtonSecondary
              SetGadgetText(1, "Right mouse button")
            Case #kEventMouseButtonTertiary
              SetGadgetText(1, "Middle mouse button")
          EndSelect
        EndIf
      EndIf
    Case #kEventClassKeyboard
      If GetEventParameter_(Event, #kEventParamKeyMacCharCodes, #typeChar, 0, 4, 0, @KeyCode) = 0
        SetGadgetText(1, Chr(KeyCode))
      EndIf
  EndSelect

  If *NextEventHandler
    CallNextEventHandler_(*NextEventHandler, Event)
  EndIf
EndProcedure

Dim EventTypes.EventTypeSpec(2)

OpenWindow(0, 200, 200, 300, 70, "Detect mouse and key events")
TextGadget(0, 10, 10, WindowWidth(0) - 20, 20, "Press mouse button or key:", #PB_Text_Center)
TextGadget(1, 10, 35, WindowWidth(0) - 20, 20, "", #PB_Text_Border | #PB_Text_Center)

; ----- Install EventHandler

EventHandlerUPP = NewEventHandlerUPP_(@EventHandler())

; ----- Intercept mouse down events

EventTypes(0)\EventClass = #kEventClassMouse
EventTypes(0)\EventKind = #kEventMouseDown

; ----- Intercept raw key down events

EventTypes(1)\EventClass = #kEventClassKeyboard
EventTypes(1)\EventKind = #kEventRawKeyDown

InstallEventHandler_(GetWindowEventTarget_(WindowID(0)), EventHandlerUPP, 2, @EventTypes(), 0, 0)

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

[Shardik]

On request of a member of the German PureBasic forum I have expanded
my example from the previous post to even display the state of the modifier
keys Shift, Ctrl, Alt, Cmd and AlphaLock. And furthermore the new version
is able to discriminate between mouse button up and down and key up and
down events:

Code: Select all

EnableExplicit

ImportC ""
  GetEventClass(Event)
EndImport

; Event Class Constants

#kEventClassMouse = 'mous'
#kEventClassKeyboard = 'keyb'

; Event Modifier Constants

#cmdKeyBit = 8
#shiftKeyBit = 9
#alphaLockBit = 10
#optionKeyBit = 11
#controlKeyBit = 12

; Event Modifier Bits

#cmdKey = 1 << #cmdKeyBit
#shiftKey = 1 << #shiftKeyBit
#alphaLock = 1 << #alphaLockBit
#optionKey = 1 << #optionKeyBit
#controlKey = 1 << #controlKeyBit

; Character Codes

#kHomeCharCode = 1
#kEnterCharCode = 3
#kEndCharCode = 4
#kBackspaceCharCode = 8
#kTabCharCode = 9
#kPageUpCharCode = 11
#kPageDownCharCode = 12
#kReturnCharCode = 13
#kFunctionKeyCharCode = 16
#kEscapeCharCode = 27
#kLeftArrowCharCode = 28
#kRightArrowCharCode = 29
#kUpArrowCharCode = 30
#kDownArrowCharCode = 31
#kSpaceCharCode = 32
#kDeleteCharCode = 127

; Keyboard Event Constants

#kEventRawKeyDown = 1
#kEventRawKeyUp = 3
#kEventRawKeyModifiersChanged = 4

; Keyboard Event Parameters and Types

#kEventParamKeyCode = 'kcod'
#kEventParamKeyMacCharCodes = 'kchr'
#kEventParamKeyModifiers = 'kmod'

; Mouse Events

#kEventMouseDown = 1
#kEventMouseUp = 2
#kEventMouseWheelMoved = 10

; Mouse Button Constants

#kEventMouseButtonPrimary = 1
#kEventMouseButtonSecondary = 2
#kEventMouseButtonTertiary = 3

; Mouse Wheel Constants

#kEventMouseWheelAxisX = 0
#kEventMouseWheelAxisY = 1

; Mouse Event Parameters

#kEventParamMouseButton = 'mbtn'
#kEventParamMouseWheelAxis = 'mwax'
#kEventParamMouseWheelDelta = 'mwdl'
#typeMouseButton = 'mbtn'
#typeMouseWheelAxis = 'mwax'

; Mouse Tracking Constants

#kMouseTrackingMouseDown = 1
#kMouseTrackingMouseUp = 2

; Types

#typeChar = 'TEXT'
#typeSInt32 = 'long'
#typeUInt32 = 'magn'

Structure EventTypeSpec
  EventClass.L
  EventKind.L
EndStructure

Define EventHandlerUPP.L
Define i.L

Dim FnKey.L(18)

For i = 0 To 18
  Read.L FnKey(i)
Next i 

ProcedureC EventHandler(*NextEventHandler, Event.L, UserData.L)
  Shared FnKey.L()

  Protected i.L
  Protected KeyCode.L
  Protected KeyModifier.L
  Protected KeyModifierList.S
  Protected KeyName.S
  Protected MouseButtonType.L
  Protected MouseWheelAxis.L
  Protected MouseWheelDelta.L
  Protected WheelInfo.S

  Select GetEventClass(Event)
    Case #kEventClassMouse
      Select GetEventKind_(Event)
        Case #kEventMouseDown
          If GetEventParameter_(Event, #kEventParamMouseButton, #typeMouseButton, 0, SizeOf(MouseButtonType), 0, @MouseButtonType) = 0
            If GetEventParameter_(Event, #kEventParamKeyModifiers, #typeUInt32, 0, SizeOf(KeyModifier), 0, @KeyModifier) = 0
              Select MouseButtonType
                Case #kEventMouseButtonPrimary
                  If KeyModifier = #controlKey
                    SetGadgetText(1, "Right mouse button")
                  Else
                    SetGadgetText(1, "Left mouse button")
                  EndIf
                Case #kEventMouseButtonSecondary
                  SetGadgetText(1, "Right mouse button")
                Case #kEventMouseButtonTertiary
                  SetGadgetText(1, "Middle mouse button")
              EndSelect
            EndIf
          EndIf
        Case #kEventMouseUp
          SetGadgetText(1, "")
        Case #kEventMouseWheelMoved
          If GetEventParameter_(Event, #kEventParamMouseWheelAxis, #typeMouseWheelAxis, 0, SizeOf(MouseWheelAxis), 0, @MouseWheelAxis) = 0
            Select MouseWheelAxis
              Case #kEventMouseWheelAxisX
                WheelInfo = "Mouse wheel moved horizontally"
              Case #kEventMouseWheelAxisY
                WheelInfo = "Mouse wheel moved vertically"
            EndSelect
          EndIf

          If GetEventParameter_(Event, #kEventParamMouseWheelDelta, #typeSInt32, 0, 4, 0, @MouseWheelDelta) = 0
            WheelInfo + ", Delta = " + Str(MouseWheelDelta)
            SetGadgetText(1, WheelInfo)
          EndIf
      EndSelect
    Case #kEventClassKeyboard
      Select GetEventKind_(Event)
        Case #kEventRawKeyDown
          GetEventParameter_(Event, #kEventParamKeyMacCharCodes, #typeChar, 0, SizeOf(KeyCode), 0, @KeyCode)

          Select KeyCode
            Case #kBackspaceCharCode
              KeyName = "Backspace"
            Case #kDeleteCharCode
              KeyName = "Delete"
            Case #kEndCharCode
              KeyName = "End"
            Case #kEnterCharCode
              KeyName = "Enter"
            Case #kEscapeCharCode
              KeyName = "Esc"
            Case #kFunctionKeyCharCode
              If GetEventParameter_(Event, #kEventParamKeyCode, #typeUInt32, 0, SizeOf(KeyModifier), 0, @KeyCode) = 0
                For i = 0 To 18
                  If KeyCode = FnKey(i)
                    KeyName = "F" + Str(i + 1)
                    Break
                  EndIf
                Next i
              EndIf
            Case #kHomeCharCode
              KeyName = "Home"
            Case #kReturnCharCode
              KeyName = "Return"
            Case #kPageDownCharCode
              KeyName = "PageDown"
            Case #kPageUpCharCode
              KeyName = "PageUp"
            Case #kSpaceCharCode
              KeyName = "Space"
            Case #kTabCharCode
              KeyName = "Tab"
            Case #kUpArrowCharCode
              KeyName = "UpArrow"
            Case #kDownArrowCharCode
              KeyName = "DownArrow"
            Case #kLeftArrowCharCode
              KeyName = "LeftArrow"
            Case #kRightArrowCharCode
              KeyName = "RightArrow"
            Default
              KeyName = LCase(Chr(KeyCode))
          EndSelect
        Case #kEventRawKeyUp
          KeyName = ""
      EndSelect

      If GetEventParameter_(Event, #kEventParamKeyModifiers, #typeUInt32, 0, SizeOf(KeyModifier), 0, @KeyModifier) = 0
        If KeyModifier & #cmdKey
          KeyModifierList + "<Cmd> "
        EndIf
        
        If KeyModifier & #shiftKey
          KeyModifierList + "<Shift> "
        EndIf
        
        If KeyModifier & #alphaLock
          KeyModifierList + "<AlphaLock> "
        EndIf
        
        If KeyModifier & #optionKey
          KeyModifierList + "<Alt> "
        EndIf
        
        If KeyModifier & #controlKey
          KeyModifierList + "<Ctrl> "
        EndIf
      EndIf

      If KeyCode
        SetGadgetText(1, KeyModifierList + "<" + KeyName + ">")
      Else
        SetGadgetText(1, KeyModifierList)
      EndIf
  EndSelect

  If *NextEventHandler
    CallNextEventHandler_(*NextEventHandler, Event)
  EndIf
EndProcedure

Dim EventTypes.EventTypeSpec(5)

OpenWindow(0, 200, 100, 420, 70, "Detect mouse button, wheel, key and modifier events")
TextGadget(0, 10, 10, WindowWidth(0) - 20, 20, "Press and hold mouse button or key:", #PB_Text_Center)
TextGadget(1, 10, 35, WindowWidth(0) - 20, 20, "", #PB_Text_Border | #PB_Text_Center)

; ----- Install EventHandler

EventHandlerUPP = NewEventHandlerUPP_(@EventHandler())

; ----- Intercept mouse button down and up events

EventTypes(0)\EventClass = #kEventClassMouse
EventTypes(0)\EventKind  = #kEventMouseDown
EventTypes(1)\EventClass = #kEventClassMouse
EventTypes(1)\EventKind  = #kEventMouseUp

; ----- Intercept raw key down and up events

EventTypes(2)\EventClass = #kEventClassKeyboard
EventTypes(2)\EventKind  = #kEventRawKeyDown
EventTypes(3)\EventClass = #kEventClassKeyboard
EventTypes(3)\EventKind  = #kEventRawKeyUp

; ----- Intercept modifier key changes

EventTypes(4)\EventClass = #kEventClassKeyboard
EventTypes(4)\EventKind  = #kEventRawKeyModifiersChanged

; ----- Intercept mouse wheel movement

EventTypes(5)\EventClass = #kEventClassMouse
EventTypes(5)\EventKind = #kEventMouseWheelMoved

InstallEventHandler_(GetWindowEventTarget_(WindowID(0)), EventHandlerUPP, 6, @EventTypes(), 0, 0)

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

End

DataSection
  Data.L 122, 120,  99, 118,  96,  97,  98, 100, 101, 109
  Data.L 103, 111, 105, 107, 113, 106,  64,  79,  80
EndDataSection

Update: I have changed Procedure to ProcedureC so that this code runs without change in Snow Leopard, Lion and Mountain Lion. Beginning with PB 5.00 you have to set the subsystem to "Carbon" in "Compiler/Compiler Options.../Library Subsystem:".

[jesperbrannmark]

Hi.
Any chance of getting the mousewheel / mousescroll in there?

Jesper

[Shardik]

Hi.
Any chance of getting the mousewheel / mousescroll in there?

Jesper

I have added the mouse wheel detection in the example code of my second post.

And on request of delikanli_19_82 from the German forum I also added the
detection and display of these special keys:

<Backspace>
<Delete>
<End>
<Enter> (Numerical keypad)
<Esc>
<Home>
<Return>
<PageDown>
<PageUp>
<Space>
<Tab>
<UpArrow>
<DownArrow>
<LeftArrow>
<RightArrow>

And furthermore also the Function keys F1-F19 are detected and displayed!

[jesperbrannmark]

Wonderful with the mousewheel - several people have asked for that. And it even takes out HOW much you scroll. This is going to be extremely useful. Thanks

[michel51]

Hello Shardik,

very good job. Thanks !!

But when I compile this in unicode, I get an "Overflow Error".
In mode "non unicode" it runs as expected.

This problem is known, because the constants like #kEventClassMouse are long integer, but in unicode the line

Code: Select all

#kEventClassMouse = 'mous'

is to long !
you have to replace the terms like 'mous' with the corresponding long number and your code will run in unicode too.

here a small snippet to get the numbers and an few numbers ready to use.

Code: Select all

pc = 'inde'
Debug PeekL(@PC)

; 'mous' = 1836021107
; 'keyb' = 1801812322
; 'wwrs' = 2004316787
; 'PURE' = 1347768901
; 'TXOB' = 1415073602
; 'inde' = 1768842341
; 'kchr' = 1801676914
; 'kmod' = 1802334052
; 'mbtn' = 1835168878
; 'TEXT' = 1413830740
; 'magn' = 1835100014
; 'cntl' = 1668183148
; 'wind' = 2003398244
; 'long' = 1819242087
; 'mwdl' = 1836541036
; 'mwax' = 1836540280
; 'kcod' = 1801678692

Hope it helps.

[Shardik]

Wonderful with the mousewheel - several people have asked for that.

If you would have taken a look into WilliamL's excellent thread "API list for Mac"
you would have seen that he already had posted a link to a code example from
me in the German forum where I already demonstrated how to read the mouse
wheel...

[jesperbrannmark]

Would it be hard work adding zoom in/zoom (pinch to zoom and tap to zoom) out to this?

[wilbert]

Would it be hard work adding zoom in/zoom (pinch to zoom and tap to zoom) out to this?

OS X 10.6 and above have built in support for those (at least Cocoa, I don't know about Carbon)
http://developer.apple.com/library/mac/ ... vents.html
Unfortunately I don't have a multitouch trackpad so I can't try it out.

[jesperbrannmark]

This code doesnt work on pb 5 beta 6...

[wilbert]

This code doesnt work on pb 5 beta 6...

Did you use the carbon subsystem ?
This code won't work on cocoa.

[jesperbrannmark]

No I didnt, but how else would I use a eventhandler to detect mousewheel etc in cocoa?

[wilbert]

No I didnt, but how else would I use a eventhandler to detect mousewheel etc in cocoa?

Cocoa uses a class named NSEvent for events.
I don't know if it will stay this way but at the moment you can access the current event within the PureBasic event loop.
That way you can detect mouse and keyboard events.

[jesperbrannmark]

I am trying to do this using this code and modify it a bit http://www.purebasic.fr/english/viewtop ... 97#p393603
This stuff is really tricky I must admit. First I have no clue on where to find the constants that are setup - how would I find similar constants for events like NSLeftMouseUp etc?
I then look at "type" and find that a scroll triggers 20 or 22 as type.
Third step i try to determine deltaX (https://developer.apple.com/library/mac ... rence.html)
I try this CocoaMessage(0, currentEvent, "deltaX") this gives me strange data. If I try CocoaMessage(0, currentEvent, "NSEvent deltaX") I just get a error. Its really tricky to understand this.. and why didn't Apple just choose to use Purebasic to begin with instead of fiddling with this Xcode beast?

[wilbert]

Its really tricky to understand this.. and why didn't Apple just choose to use Purebasic to begin with instead of fiddling with this Xcode beast?

It's not really tricky. It may just be a bit hard to understand if you are just starting out with Cocoa functionality
Why Apple didn't just choose PureBasic. Very good question

Anyway ... does this help you out ?

Code: Select all

#NSLeftMouseUp        = 2
#NSRightMouseUp       = 4
#NSMouseMoved         = 5
#NSKeyDown            = 10
#NSKeyUp              = 11
#NSScrollWheel        = 22

#NSAlphaShiftKeyMask = 1 << 16
#NSShiftKeyMask      = 1 << 17
#NSControlKeyMask    = 1 << 18
#NSAlternateKeyMask  = 1 << 19
#NSCommandKeyMask    = 1 << 20

EnableExplicit

Global sharedApplication = CocoaMessage(0, 0, "NSApplication sharedApplication")
Define currentEvent, type, modifierFlags, keyCode
Define clickCount, location.NSPoint, deltaX.CGFloat, deltaY.CGFloat
Define Event

If OpenWindow(0, 0, 0, 320, 170, "Events example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  EditorGadget(0, 10, 10, 300, 100, #PB_Editor_ReadOnly)
  
  Repeat
    
    Event = WaitWindowEvent()
    currentEvent = CocoaMessage(0, sharedApplication, "currentEvent")
    If currentEvent
      type = CocoaMessage(0, currentEvent, "type")
      modifierFlags = CocoaMessage(0, currentEvent, "modifierFlags")
      
      ClearGadgetItems(0)
      
      ; mouse events
      
      If type = #NSLeftMouseUp
        clickCount = CocoaMessage(0, currentEvent, "clickCount")
        SetGadgetText(0, "Left mouse " + Str(clickCount) + "x clicked")
      EndIf
      
      If type = #NSRightMouseUp
        clickCount = CocoaMessage(0, currentEvent, "clickCount")
        SetGadgetText(0, "Right mouse " + Str(clickCount) + "x clicked")
      EndIf
      
      If type = #NSMouseMoved
        CocoaMessage(@location, currentEvent, "locationInWindow")
        SetGadgetText(0, "Mouse moved to (" + StrF(location\x, 1) + "," + StrF(WindowHeight(0)-location\y, 1) + ")"); use WindowHeight() to flip y coordinate
      EndIf
      
      If type = #NSScrollWheel
        CocoaMessage(@deltaX, currentEvent, "deltaX")
        CocoaMessage(@deltaY, currentEvent, "deltaY")
        SetGadgetText(0, "Mouse wheel delta (" + StrF(deltaX, 1) + "," + StrF(deltaY, 1) + ")")
      EndIf
      
      ; keyboard events
      
      If type = #NSKeyDown
        keyCode = CocoaMessage(0, currentEvent, "keyCode")
        SetGadgetText(0, "Key down with code : " + Str(keyCode))
      EndIf
      
      If type = #NSKeyUp
        keyCode = CocoaMessage(0, currentEvent, "keyCode")
        SetGadgetText(0, "Key up with code : " + Str(keyCode))
      EndIf
      
      ; key modifiers
      
      If modifierFlags & #NSAlphaShiftKeyMask  
        AddGadgetItem(0, -1, "Caps lock is on")
      Else
        AddGadgetItem(0, -1, "Caps lock is off")
      EndIf
      If modifierFlags & #NSShiftKeyMask
        AddGadgetItem(0, -1, "Shift key is pressed")
      EndIf
      If modifierFlags & #NSControlKeyMask
        AddGadgetItem(0, -1, "Ctrl key is pressed")
      EndIf
      If modifierFlags & #NSAlternateKeyMask
        AddGadgetItem(0, -1, "Alt key is pressed")
      EndIf
      If modifierFlags & #NSCommandKeyMask
        AddGadgetItem(0, -1, "Cmd key is pressed")
      EndIf
      
    EndIf
    
  Until Event = #PB_Event_CloseWindow
EndIf