diff options
Diffstat (limited to 'highway')
| -rw-r--r-- | highway/Main.hs | 29 |
1 files changed, 13 insertions, 16 deletions
diff --git a/highway/Main.hs b/highway/Main.hs index a13fa0e..2e8161d 100644 --- a/highway/Main.hs +++ b/highway/Main.hs @@ -20,22 +20,18 @@ geometry = WLOutput.Geometry { WLOutput.x = 0 , WLOutput.transform = WLOutput.TransformNormal } -data BindRequest - = BindOutput WLOutput.Handle - | UnbindOutput WLOutput.Handle +data CustomRequest + = ReqBindOutput (NewObject WLOutput.WLOutput) + | ReqDestroyOutput WLOutput.WLOutput + | ReqSIGINT deriving (Typeable, Show) -data SignalRequest - = ReqSIGINT - deriving (Typeable, Show) - -instance RequestClass SignalRequest -instance RequestClass BindRequest +instance RequestClass CustomRequest data Output = Output deriving (Show) -data State = State { _outputs :: M.Map WLOutput.Handle Output +data State = State { _outputs :: M.Map WLOutput.WLOutput Output , _interruptedCount :: Int } deriving (Show) @@ -44,13 +40,14 @@ makeLenses ''State handleRequest :: Request -> DisplayM State () handleRequest r - | Just (WLOutput.ReqRelease o) <- fromRequest r = destroyResource o - | Just (BindOutput o) <- fromRequest r = do outs <- outputs <%= M.insert o Output - sendEvent o $ WLOutput.EvGeometry geometry - sendEvent o $ WLOutput.EvDone + | Just (WLOutput.ReqRelease o) <- fromRequest r = destroyObject o + | Just (ReqBindOutput o) <- fromRequest r = do output <- createObject o ReqDestroyOutput + outs <- outputs <%= M.insert output Output + sendEvent output $ WLOutput.EvGeometry geometry + sendEvent output $ WLOutput.EvDone liftIO $ putStrLn $ "Created output, outputs: " ++ show outs flushEvents - | Just (UnbindOutput o) <- fromRequest r = outputs %= M.delete o + | Just (ReqDestroyOutput o) <- fromRequest r = outputs %= M.delete o | Just ReqSIGINT <- fromRequest r = do c <- interruptedCount <%= (+1) liftIO $ putStrLn $ "Received SIGINT " ++ show c ++ "/3" when (c >= 3) requestTermination @@ -61,6 +58,6 @@ main = void $ withDisplay (State M.empty 0) $ do socket <- bindSocket liftIO $ putStrLn $ "Listening on socket: " ++ socket _ <- registerSignalEvent ReqSIGINT 2 - output <- registerGlobal BindOutput UnbindOutput 4 + output <- registerGlobal ReqBindOutput 4 processRequests handleRequest unregisterGlobal output |