From 20f8421426069b50549cc439d7b4f2d04e16b2b8 Mon Sep 17 00:00:00 2001 From: Syed Daanish Date: Sat, 25 Jul 2026 22:04:22 +0100 Subject: [PATCH] Add basic event handling --- app/WM/Core.hs | 19 ++++++++++++++- app/WM/XKutu.hs | 62 +++++++++++++++++++++++++++++++++++++++++++------ kutu.cabal | 2 +- 3 files changed, 74 insertions(+), 9 deletions(-) diff --git a/app/WM/Core.hs b/app/WM/Core.hs index 50c7104..d6b37df 100644 --- a/app/WM/Core.hs +++ b/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 () diff --git a/app/WM/XKutu.hs b/app/WM/XKutu.hs index e7f6d43..d96f977 100644 --- a/app/WM/XKutu.hs +++ b/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 () diff --git a/kutu.cabal b/kutu.cabal index 1790835..b2b036f 100644 --- a/kutu.cabal +++ b/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