Add basic event handling

app/WM/Core.hs

@@ -4,6 +4,7 @@ import Control.Concurrent (threadDelay)
 import Control.Exception (bracket)
 import Foreign (Ptr)
 import System.Environment (getArgs)
+import System.Process
 import WM.Layout
 import WM.Mruby
 import WM.XKutu
@@ -28,6 +29,8 @@ run = do
   is_started <- deploy
   print is_started
   add_keybind 24 0
+  add_keybind 25 0
+  add_keybind 26 0
   w_id <- draw_rectangle 10 100 10 10 0x500070
   geom <- get_geometry w_id
   print geom
@@ -50,10 +53,24 @@ handle_args mrb = do
       runRuby mrb script
     _ -> putStrLn "unknown arguments"
 
+handle_key :: State -> Event -> IO State
+handle_key s (Event {event_btn = 24}) = get_focus >>= kill >> pure s
+handle_key s (Event {event_btn = 25}) = runCommand "kitty" >> pure s
+handle_key s (Event {event_btn = 26}) = pure s {running = False}
+handle_key s _ = pure s
+
+handle_show :: State -> Event -> IO State
+handle_show s ev = do
+  let win = event_window ev
+  c_show win
+  focus win
+  pure s
+
 handle_event :: Maybe Event -> State -> IO State
 handle_event Nothing s = pure s
 handle_event (Just ev) s
-  | event_btn ev == 24 = pure s {running = False}
+  | event_type ev == EvKeyPress = handle_key s ev
+  | event_type ev == EvShowRequest = handle_show s ev
   | otherwise = print ev >> pure s
 
 loop :: State -> IO ()

app/WM/XKutu.hs

@@ -59,7 +59,7 @@ instance Storable PointerInfo where
     pokeByteOff ptr 4 w
 
 data Event = Event
-  { event_type :: Int32,
+  { event_type :: EventType,
     event_window :: XcbWindow,
     event_override_redirect :: Int8,
     event_btn :: Word32,
@@ -72,12 +72,62 @@ data Event = Event
   }
   deriving (Show)
 
+data EventType
+  = EvNone
+  | EvCreate
+  | EvClosed
+  | EvEnter
+  | EvShowed
+  | EvShowRequest
+  | EvMousePress
+  | EvMouseDrag
+  | EvMouseRelease
+  | EvKeyPress
+  | EvKeyRelease
+  | EvClosedTemp
+  | EvConfigureRequest
+  | EvResizeRequest
+  deriving (Show, Eq, Bounded)
+
+instance Enum EventType where
+  fromEnum ev = case ev of
+    EvNone -> 0
+    EvCreate -> 1
+    EvClosed -> 2
+    EvEnter -> 3
+    EvShowed -> 4
+    EvShowRequest -> 5
+    EvMousePress -> 6
+    EvMouseDrag -> 7
+    EvMouseRelease -> 8
+    EvKeyPress -> 9
+    EvKeyRelease -> 10
+    EvClosedTemp -> 11
+    EvConfigureRequest -> 12
+    EvResizeRequest -> 13
+  toEnum n = case n of
+    0 -> EvNone
+    1 -> EvCreate
+    2 -> EvClosed
+    3 -> EvEnter
+    4 -> EvShowed
+    5 -> EvShowRequest
+    6 -> EvMousePress
+    7 -> EvMouseDrag
+    8 -> EvMouseRelease
+    9 -> EvKeyPress
+    10 -> EvKeyRelease
+    11 -> EvClosedTemp
+    12 -> EvConfigureRequest
+    13 -> EvResizeRequest
+    _ -> error $ "Unknown C EventType number: " ++ show n
+
 instance Storable Event where
   sizeOf _ = 40
   alignment _ = alignment (undefined :: Word32)
-
   peek ptr = do
-    eventType <- peekByteOff ptr 0
+    rawType <- peekByteOff ptr 0 :: IO Int32
+    let eventType = toEnum (fromIntegral rawType)
     window <- peekByteOff ptr 4
     overrideRedirect <- peekByteOff ptr 8
     btn <- peekByteOff ptr 12
@@ -87,7 +137,6 @@ instance Storable Event where
     width <- peekByteOff ptr 28
     state <- peekByteOff ptr 32
     isRoot <- peekByteOff ptr 36
-
     pure $
       Event
         eventType
@@ -100,9 +149,8 @@ instance Storable Event where
         width
         state
         isRoot
-
   poke ptr (Event eventType (XcbWindow window) overrideRedirect btn x y height width state isRoot) = do
-    pokeByteOff ptr 0 eventType
+    pokeByteOff ptr 0 (fromIntegral (fromEnum eventType) :: Int32)
     pokeByteOff ptr 4 window
     pokeByteOff ptr 8 overrideRedirect
     pokeByteOff ptr 12 btn
@@ -165,7 +213,7 @@ foreign import capi "x_kutu.h destroy"
   destroy :: XcbWindow -> IO ()
 
 foreign import capi "x_kutu.h show"
-  show :: XcbWindow -> IO ()
+  c_show :: XcbWindow -> IO ()
 
 foreign import capi "x_kutu.h hide"
   hide :: XcbWindow -> IO ()

kutu.cabal

@@ -25,7 +25,7 @@ executable kutu
         WM.Mruby
         WM.Layout
 
-    build-depends:    base, bytestring
+    build-depends:    base, bytestring, process
 
     hs-source-dirs:   app