Add basic event handling
This commit is contained in:
+18
-1
@@ -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 ()
|
||||
|
||||
+55
-7
@@ -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 ()
|
||||
|
||||
Reference in New Issue
Block a user