File: Keys.hs

package info (click to toggle)
haskell-termonad 0.2.1.0-2
  • links: PTS
  • area: main
  • in suites: buster
  • size: 268 kB
  • sloc: haskell: 1,892; makefile: 7
file content (118 lines) | stat: -rw-r--r-- 3,131 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118

module Termonad.Keys where

import Termonad.Prelude

import Control.Lens (imap)
import GI.Gdk
  ( EventKey
  , pattern KEY_1
  , pattern KEY_2
  , pattern KEY_3
  , pattern KEY_4
  , pattern KEY_5
  , pattern KEY_6
  , pattern KEY_7
  , pattern KEY_8
  , pattern KEY_9
  , ModifierType(..)
  , getEventKeyHardwareKeycode
  , getEventKeyIsModifier
  , getEventKeyKeyval
  , getEventKeyLength
  , getEventKeyState
  , getEventKeyString
  , getEventKeyType
  )

import Termonad.Term (altNumSwitchTerm)
import Termonad.Types (TMState)


showKeys :: EventKey -> IO Bool
showKeys eventKey = do
  eventType <- getEventKeyType eventKey
  maybeString <- getEventKeyString eventKey
  modifiers <- getEventKeyState eventKey
  len <- getEventKeyLength eventKey
  keyval <- getEventKeyKeyval eventKey
  isMod <- getEventKeyIsModifier eventKey
  keycode <- getEventKeyHardwareKeycode eventKey

  putStrLn "key press event:"
  putStrLn $ "  type = " <> tshow eventType
  putStrLn $ "  str = " <> tshow maybeString
  putStrLn $ "  mods = " <> tshow modifiers
  putStrLn $ "  isMod = " <> tshow isMod
  putStrLn $ "  len = " <> tshow len
  putStrLn $ "  keyval = " <> tshow keyval
  putStrLn $ "  keycode = " <> tshow keycode
  putStrLn ""

  pure True

data Key = Key
  { keyVal :: Word32
  , keyMods :: Set ModifierType
  } deriving (Eq, Ord, Show)

toKey :: Word32 -> Set ModifierType -> Key
toKey = Key

keyMap :: Map Key (TMState -> IO Bool)
keyMap =
  let numKeys =
        [ KEY_1
        , KEY_2
        , KEY_3
        , KEY_4
        , KEY_5
        , KEY_6
        , KEY_7
        , KEY_8
        , KEY_9
        ]
      altNumKeys =
        imap
          (\i k ->
             (toKey k [ModifierTypeMod1Mask], stopProp (altNumSwitchTerm i))
          )
          numKeys
  in
  mapFromList altNumKeys

stopProp :: (TMState -> IO a) -> TMState -> IO Bool
stopProp callback terState = callback terState $> True

removeStrangeModifiers :: Key -> Key
removeStrangeModifiers Key{keyVal, keyMods} =
  let reservedModifiers =
        [ ModifierTypeModifierReserved13Mask
        , ModifierTypeModifierReserved14Mask
        , ModifierTypeModifierReserved15Mask
        , ModifierTypeModifierReserved16Mask
        , ModifierTypeModifierReserved17Mask
        , ModifierTypeModifierReserved18Mask
        , ModifierTypeModifierReserved19Mask
        , ModifierTypeModifierReserved20Mask
        , ModifierTypeModifierReserved21Mask
        , ModifierTypeModifierReserved22Mask
        , ModifierTypeModifierReserved23Mask
        , ModifierTypeModifierReserved24Mask
        , ModifierTypeModifierReserved25Mask
        , ModifierTypeModifierReserved29Mask
        ]
  in Key keyVal (difference keyMods reservedModifiers)


handleKeyPress :: TMState -> EventKey -> IO Bool
handleKeyPress terState eventKey = do
  -- void $ showKeys eventKey
  keyval <- getEventKeyKeyval eventKey
  modifiers <- getEventKeyState eventKey
  let oldKey = toKey keyval (setFromList modifiers)
      newKey = removeStrangeModifiers oldKey
      maybeAction = lookup newKey keyMap
  case maybeAction of
    Just action -> action terState
    Nothing -> pure False