rofi-extras/app/rofi.hs

100 lines
3.5 KiB
Haskell
Raw Normal View History

--------------------------------------------------------------------------------
2023-02-13 22:19:49 -05:00
-- Run rofi (and display on the correct screen)
--
-- Since this seems random, the reason for this is that I want rofi to appear
-- over the current xmonad workspace, and rofi has no concept of what an
-- xmonad workspace is (not that it is supposed to, xmonad is weird...). Rofi
-- accepts the name of an xrandr output onto which it should appear, so this
2022-08-07 22:18:40 -04:00
-- binary determines which xmonad workspace is in focus and calls rofi with the
-- name of that workspace.
--
-- Assumptions: xmonad sets the _NET_DESKTOP_VIEWPORT atom with the positions of
-- the active workspace (actually an array of the positions of all workspaces
-- but the rest don't matter if I only care about the active one). This is not
-- default behavior and not in any contrib modules (yet) so I added this myself
-- using a custom loghook.
--
-- Steps:
-- 1) Get _NET_CURRENT_DESKTOP to find index of active workspace
-- 2) Use index from (1) and to get the position of the active workspace from
-- _NET_DESKTOP_VIEWPORT
-- 3) Find the name of the xrandr output whose position matches that from (2)
2022-08-07 22:18:40 -04:00
-- 4) Call rofi with the '-m' flag to override the default monitor placement
2023-02-13 22:19:49 -05:00
module Main (main) where
2023-02-13 22:19:49 -05:00
import Graphics.X11.Types
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xrandr
import RIO hiding (Display)
2023-02-16 22:40:24 -05:00
import RIO.Process
2023-02-13 23:31:50 -05:00
import qualified RIO.Text as T
2023-02-16 22:40:24 -05:00
import UnliftIO.Environment
main :: IO ()
2023-02-16 22:40:24 -05:00
main = runSimpleApp $ do
2024-01-07 11:49:30 -05:00
r <- getMonitorName
2022-08-07 22:18:40 -04:00
args <- getArgs
2024-01-07 11:49:30 -05:00
let allArgs = maybe [] (\n -> ["-m", T.unpack n] ++ args) r
c <- proc "/usr/bin/rofi" allArgs runProcess
exitWith c
2022-08-07 22:18:40 -04:00
data Coord = Coord Int Int deriving (Eq, Show)
2024-01-07 11:49:30 -05:00
-- TODO bracket this
2023-02-16 22:40:24 -05:00
getMonitorName :: MonadIO m => m (Maybe T.Text)
2024-01-07 11:49:30 -05:00
getMonitorName = liftIO $ do
dpy <- openDisplay ""
root <- rootWindow dpy $ defaultScreen dpy
index <- getCurrentDesktopIndex dpy root
viewports <- getDesktopViewports dpy root
outputs <- getOutputs dpy root
return $ flip lookup outputs =<< (viewports !!?) =<< index
getCurrentDesktopIndex :: Display -> Window -> IO (Maybe Int)
getCurrentDesktopIndex dpy root =
(!!? 0) <$> getAtom32 dpy root "_NET_CURRENT_DESKTOP"
getDesktopViewports :: Display -> Window -> IO [Coord]
getDesktopViewports dpy root =
pairs <$> getAtom32 dpy root "_NET_DESKTOP_VIEWPORT"
where
pairs = reverse . pairs' []
2023-02-13 22:19:49 -05:00
pairs' acc (x1 : x2 : xs) = pairs' (Coord x1 x2 : acc) xs
pairs' acc _ = acc
2023-02-13 23:31:50 -05:00
getOutputs :: Display -> Window -> IO [(Coord, T.Text)]
2023-02-13 22:19:49 -05:00
getOutputs dpy root =
xrrGetScreenResourcesCurrent dpy root
>>= maybe (return []) resourcesToCells
where
resourcesToCells r = catMaybes <$> mapM (outputToCell r) (xrr_sr_outputs r)
outputToCell r o = xrrGetOutputInfo dpy r o >>= infoToCell r
-- connection: 0 == connected, 1 == disconnected
2023-02-13 22:19:49 -05:00
infoToCell
r
( Just
XRROutputInfo
{ xrr_oi_connection = 0
, xrr_oi_name = n
, xrr_oi_crtc = c
}
) = do
2023-02-13 23:31:50 -05:00
fmap (\i -> (toCoord i, T.pack n)) <$> xrrGetCrtcInfo dpy r c
infoToCell _ _ = return Nothing
toCoord c = Coord (fromIntegral $ xrr_ci_x c) (fromIntegral $ xrr_ci_y c)
infix 9 !!?
2023-02-13 22:19:49 -05:00
(!!?) :: [a] -> Int -> Maybe a
(!!?) xs i
2023-02-13 22:19:49 -05:00
| i < 0 = Nothing
| otherwise = listToMaybe $ drop i xs
2023-02-13 23:31:50 -05:00
getAtom32 :: Display -> Window -> T.Text -> IO [Int]
getAtom32 dpy root str = do
2023-02-13 23:31:50 -05:00
a <- internAtom dpy (T.unpack str) False
p <- getWindowProperty32 dpy a root
return $ maybe [] (fmap fromIntegral) p