85 lines
1.9 KiB
Haskell
85 lines
1.9 KiB
Haskell
module WM.Core where
|
|
|
|
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
|
|
|
|
data State = State
|
|
{ mruby_pointer :: !(Ptr MrbState),
|
|
running :: !Bool,
|
|
root :: !(Maybe Tile)
|
|
}
|
|
deriving (Show)
|
|
|
|
newState :: Ptr MrbState -> State
|
|
newState ptr =
|
|
State
|
|
{ mruby_pointer = ptr,
|
|
running = True,
|
|
root = Nothing
|
|
}
|
|
|
|
run :: IO ()
|
|
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
|
|
screen_info <- get_screen
|
|
print screen_info
|
|
pointer_info <- get_pointer
|
|
print pointer_info
|
|
bracket mrb_open mrb_close $ \mrb -> do
|
|
loadRubyLibs mrb
|
|
handle_args mrb
|
|
loop (newState mrb)
|
|
|
|
handle_args :: Ptr MrbState -> IO ()
|
|
handle_args mrb = do
|
|
args <- getArgs
|
|
case args of
|
|
[] -> pure ()
|
|
["--script", file] -> do
|
|
script <- readFile file
|
|
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_type ev == EvKeyPress = handle_key s ev
|
|
| event_type ev == EvShowRequest = handle_show s ev
|
|
| otherwise = print ev >> pure s
|
|
|
|
loop :: State -> IO ()
|
|
loop state
|
|
| not (running state) = pure ()
|
|
| otherwise = do
|
|
flush
|
|
threadDelay 10000
|
|
ev <- next_event
|
|
handle_event ev state
|
|
>>= loop
|