diff options
| -rw-r--r-- | src/Rahm/Desktop/WorkspaceWheel.hs | 81 |
1 files changed, 65 insertions, 16 deletions
diff --git a/src/Rahm/Desktop/WorkspaceWheel.hs b/src/Rahm/Desktop/WorkspaceWheel.hs index f841bfb..a89dc6a 100644 --- a/src/Rahm/Desktop/WorkspaceWheel.hs +++ b/src/Rahm/Desktop/WorkspaceWheel.hs @@ -11,8 +11,10 @@ import Control.Arrow (Arrow (first, second)) import Control.Concurrent (threadDelay) import Control.Monad (forM_) import Control.Monad.Trans.Maybe (MaybeT (runMaybeT)) +import Data.Char (toLower) import Data.Function (fix) import Data.List (find, sortBy) +import qualified Data.Map as Map import Data.Maybe (fromMaybe, isNothing) import Data.Monoid (Endo (Endo, appEndo)) import Data.Ord (comparing) @@ -35,11 +37,27 @@ dzenSize = 100 data ScreenType = Current | Visible | Hidden deriving (Eq) +data WorkspaceWheelType = Existing | Alphabet Bool Bool | Digits + displayWorkspaceWheel :: X () -displayWorkspaceWheel = uncurry displayWorkspaceWheelAtPoint =<< pointerLocation +displayWorkspaceWheel = + uncurry (displayWorkspaceWheelAtPoint workspaceWheelTypeRing) + =<< pointerLocation data Ring a = Ring Int [a] (Maybe a) [a] +workspaceWheelTypeRing :: Ring WorkspaceWheelType +workspaceWheelTypeRing = + ringAdv $ + mkRing + [ Existing, + Alphabet False False, + Alphabet False True, + Alphabet True False, + Alphabet True True, + Digits + ] + mkRing :: [a] -> Ring a mkRing lst = let as = cycle lst @@ -72,28 +90,24 @@ displayWorkspaceWheelInCenter = mapM_ ( \(W.screenDetail -> (SD (Rectangle x y w h))) -> displayWorkspaceWheelAtPoint + workspaceWheelTypeRing (fromIntegral $ x + (fromIntegral w `div` 2)) (fromIntegral $ y + (fromIntegral h `div` 2)) ) =<< pointerScreen -displayWorkspaceWheelAtPoint :: Int -> Int -> X () -displayWorkspaceWheelAtPoint px py = do +displayWorkspaceWheelAtPoint :: Ring WorkspaceWheelType -> Int -> Int -> X () +displayWorkspaceWheelAtPoint wheelType px py = do click (W.StackSet cur vis other _floating) <- gets windowset screen <- fromMaybe cur <$> pointerScreen - let allWorkspaces :: [(W.Workspace WorkspaceId (Layout Window) Window, ScreenType)] - allWorkspaces = - sortBy (comparing (W.tag . fst)) $ - ((W.workspace cur, Current) : map ((,Visible) . W.workspace) vis) - ++ filter - (\(w, _) -> (not . null . W.integrate' . W.stack) w && W.tag w /= "*") - (map (,Hidden) other) - (SD rect) = W.screenDetail screen - dzenRects = calculatePositions px py rect allWorkspaces - rectsToWorkspaces = map (second (first W.tag)) dzenRects + allWorkspaces <- getWorkspaces (fromMaybe Existing $ ringCur wheelType) + + let (SD rect) = W.screenDetail screen + rectsToWorkspaces = calculatePositions px py rect allWorkspaces + -- rectsToWorkspaces = map (second (first W.tag)) dzenRects dzenPipes <- mapM (uncurry launchDzen) rectsToWorkspaces @@ -105,6 +119,11 @@ displayWorkspaceWheelAtPoint px py = do case evt of Nothing -> return stop -- timeout + Just (ButtonPress _ b) + | b == button4 -> + return (displayWorkspaceWheelAtPoint (ringAdv wheelType) px py) + | b == button5 -> + return (displayWorkspaceWheelAtPoint (ringPrev wheelType) px py) Just (ButtonPress _ b) -> withDisplay $ \d -> do (_, _, _, fi -> cx, fi -> cy, _, _, _) <- @@ -114,7 +133,7 @@ displayWorkspaceWheelAtPoint px py = do if | b == button1 -> do gotoWorkspace ws - return (displayWorkspaceWheelAtPoint px py) + return (displayWorkspaceWheelAtPoint wheelType px py) | b == button3 -> do selection <- getAndResetWindowSelectionOrCurrent withWindowsUnpinned selection $ @@ -122,7 +141,7 @@ displayWorkspaceWheelAtPoint px py = do appEndo $ mconcat (map (Endo . W.shiftWin ws) selection) - return (displayWorkspaceWheelAtPoint px py) + return (displayWorkspaceWheelAtPoint wheelType px py) | b == 13 -> do winSet <- gets windowset let mWs = find ((== ws) . W.tag) (W.workspaces winSet) @@ -140,7 +159,7 @@ displayWorkspaceWheelAtPoint px py = do map (Endo . W.delete) allWindows X.refresh - return (displayWorkspaceWheelAtPoint px py) + return (displayWorkspaceWheelAtPoint wheelType px py) | otherwise -> return stop Nothing -> return stop Just (KeyPress _ sym _ _) -> do @@ -185,6 +204,36 @@ displayWorkspaceWheelAtPoint px py = do select (pipe, (rect, (wsName, screenType))) = io $ hPutStrLn pipe $ printf "^fg(#ff0)%s" wsName + getWorkspaces :: WorkspaceWheelType -> X [(WorkspaceId, ScreenType)] + getWorkspaces Existing = do + (W.StackSet cur vis other _floating) <- gets windowset + return $ + map (first W.tag) $ + sortBy (comparing (W.tag . fst)) $ + ((W.workspace cur, Current) : map ((,Visible) . W.workspace) vis) + ++ filter + (\(w, _) -> (not . null . W.integrate' . W.stack) w && W.tag w /= "*") + (map (,Hidden) other) + getWorkspaces (Alphabet isGreek b) = + getWorkspacesForAlphabet + ( map (if b then id else toLower) $ + if isGreek then "ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ" else "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + ) + + getWorkspaces Digits = + getWorkspacesForAlphabet "0123456789" + + getWorkspacesForAlphabet a = do + (W.StackSet cur vis other _floating) <- gets windowset + let screenTypeById = + Map.fromList $ + map (first (W.tag . W.workspace)) $ + (cur, Current) : map (,Visible) vis + return $ + map + (\c -> ([c], fromMaybe Hidden $ Map.lookup [c] screenTypeById)) + a + -- Returns, starting x, dzen width calculatePositions :: Int -> Int -> Rectangle -> [a] -> [(Rectangle, a)] calculatePositions |