diff options
Diffstat (limited to 'XMonad/Hooks')
| -rw-r--r-- | XMonad/Hooks/WallpaperSetter.hs | 84 |
1 files changed, 41 insertions, 43 deletions
diff --git a/XMonad/Hooks/WallpaperSetter.hs b/XMonad/Hooks/WallpaperSetter.hs index feb409b..5f0f608 100644 --- a/XMonad/Hooks/WallpaperSetter.hs +++ b/XMonad/Hooks/WallpaperSetter.hs @@ -29,19 +29,18 @@ import qualified XMonad.Util.ExtensibleState as XS import System.IO import System.Process -import System.Exit import System.Directory (getHomeDirectory, doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath ((</>)) -import System.Random (getStdRandom, randomR) +import System.Random (randomRIO) import qualified Data.Map as M -import qualified Data.Text as T import Data.List (intersperse, sortBy) import Data.Char (isAlphaNum) import Data.Ord (comparing) -import Control.Monad (when, unless, join) -import Data.Maybe (isNothing, fromJust, fromMaybe) +import Control.Monad +import Control.Applicative +import Data.Maybe import Data.Monoid -- $usage @@ -70,9 +69,9 @@ import Data.Monoid -- * find out how to merge multiple images from stdin to one (-> for caching all pictures in memory) -- | internal. to use XMonad state for memory in-between log-hook calls and remember PID of old external call -data WCState = WCState [(String,String)] (Maybe ProcessHandle) deriving Typeable +data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle) deriving Typeable instance ExtensionClass WCState where - initialValue = WCState [] Nothing + initialValue = WCState Nothing Nothing -- | Represents a wallpaper data Wallpaper = WallpaperFix FilePath -- ^ Single, fixed wallpaper @@ -94,6 +93,7 @@ data WallpaperConf = WallpaperConf { } deriving (Show, Read) -- | default configuration. looks in \~\/.wallpapers/ for WORKSPACEID.jpg +defWallpaperConf :: WallpaperConf defWallpaperConf = WallpaperConf "" $ WallpaperList [] -- |returns the default association list (maps name to name.jpg, non-alphanumeric characters are omitted) @@ -103,11 +103,9 @@ defWPNames xs = WallpaperList $ map (\x -> (x,WallpaperFix (filter isAlphaNum x+ -- | Add this to your log hook with the workspace configuration as argument. wallpaperSetter :: WallpaperConf -> X () wallpaperSetter wpconf = do - WCState st h <- XS.get - let oldws = fromMaybe "" $ M.lookup "oldws" $ M.fromList st + WCState oldws h <- XS.get visws <- getVisibleWorkspaces - when (show visws /= oldws) $ do - -- debug $ show visws + when (Just visws /= oldws) $ do wpconf' <- completeWPConf wpconf wspicpaths <- getPicPathsAndWSRects wpconf' @@ -118,7 +116,7 @@ wallpaperSetter wpconf = do Just pid -> liftIO $ terminateProcess pid handle <- applyWallpaper wspicpaths - XS.put $ WCState [("oldws", show visws)] $ Just handle + XS.put $ WCState (Just visws) $ Just handle -- Helper functions ------------------- @@ -126,7 +124,7 @@ wallpaperSetter wpconf = do -- | Picks a random element from a list pickFrom :: [a] -> IO a pickFrom list = do - i <- getStdRandom $ randomR (0,length list - 1) + i <- randomRIO (0,length list - 1) return $ list !! i -- | get absolute picture path of the given wallpaper picture @@ -149,9 +147,13 @@ getPicPath conf (WallpaperFix file) = do -- (requires imagemagick tool identify to be installed) getPicRes :: FilePath -> IO (Maybe (Int,Int)) getPicRes picpath = do - (_, Just outh,_,pid) <- createProcess $ (proc "identify" [picpath]) { std_out = CreatePipe } + (_, Just outh,_,_pid) <- createProcess $ (proc "identify" ["-format", "%w %h", picpath]) { std_out = CreatePipe } output <- hGetContents outh - return $ if (length $ words output) < 3 then Nothing else splitRes (words output !! 2) + return $ case map reads (words output) of + -- mapM Text.Read.readMaybe is better but only in ghc>=7.6 + [[(w,"")],[(h,"")]] -> Just (w,h) + _ -> Nothing + -- |complete unset fields to default values (wallpaper directory = ~/.wallpapers, -- expects a file "NAME.jpg" for each workspace named NAME) @@ -172,15 +174,15 @@ getVisibleWorkspaces = do getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)] getPicPathsAndWSRects wpconf = do winset <- gets windowset - paths <- liftIO $ getPicPaths wpconf + paths <- liftIO getPicPaths visws <- getVisibleWorkspaces let visscr = S.current winset : S.visible winset visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr - hasPicAndIsVisible (n, mp) = n `elem` visws && (not$isNothing mp) + hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp) getRect tag = screenRect $ fromJust $ M.lookup tag visrects foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths return foundpaths - where getPicPaths wpconf = mapM (\(x,y) -> getPicPath wpconf y + where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y >>= \p -> return (x,p)) wl WallpaperList wl = wallpapers wpconf @@ -194,29 +196,25 @@ applyWallpaper parts = do endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -" cmd = basepart ++ (concat $ intersperse " " layers) ++ endpart liftIO $ runCommand cmd - where - getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens - where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx - , fromIntegral ((fromIntegral y)+h) `max` my ) - needsRotation (px,py) rect = let wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect) - pratio = fromIntegral px / fromIntegral py - in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1 - layerCommand (rect, path) = do - res <- getPicRes path - if isNothing res then return "" - else do let rotate = needsRotation (fromJust res) rect - return $ " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "") - ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)" - ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite " - - --- | internal. output string to /tmp/DEBUG -debug str = liftIO $ runCommand $ "echo \"" ++ str ++ "\" >> /tmp/DEBUG" - --- |split a string at a delimeter -split delim str = map T.unpack $ T.splitOn (T.pack delim) (T.pack str) --- |XxY -> Maybe (X,Y) -splitRes str = ret - where toks = map (\x -> read x :: Int) $ split "x" str - ret = if length toks < 2 then Nothing else Just (toks!!0,toks!!1) + +getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer) +getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens + where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx + , fromIntegral ((fromIntegral y)+h) `max` my ) + +needsRotation :: Rectangle -> (Int,Int) -> Bool +needsRotation rect (px,py) = let wratio, pratio :: Double + wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect) + pratio = fromIntegral px / fromIntegral py + in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1 + +layerCommand :: (Rectangle, FilePath) -> IO String +layerCommand (rect, path) = do + res <- getPicRes path + return $ case needsRotation rect <$> res of + Nothing -> "" + Just rotate -> + " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "") + ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)" + ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite " |