twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-29 02:13:48 -07:00
Code Issues Packages Projects Releases Wiki Activity

X.H.WallpaperSetter: Add defWPNamesPng, defWPNamesJpg

Browse Source 
This also deprecates defWPNames in favour of the (equivalent)
defWPNamesJpg.
This commit is contained in:
oogeek
2021-04-18 00:43:05 +08:00
committed by slotThe
parent 41df4b4079
commit e214c94f0d
1 changed files with 20 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
XMonad/Hooks/WallpaperSetter.hs
View File

@@ -19,7 +19,7 @@ module XMonad.Hooks.WallpaperSetter (
, Wallpaper(..)
, WallpaperList(..)
, defWallpaperConf
, defWPNames
, defWPNamesJpg, defWPNamesPng, defWPNames
-- *TODO
-- $todo
) where
@@ -34,7 +34,7 @@ import System.FilePath ((</>))
import System.Random (randomRIO)
import qualified Data.Map as M
import Data.List (intersperse, sortBy)
import Data.List (sortBy)
import Data.Char (isAlphaNum)
import Data.Ord (comparing)
@@ -82,7 +82,7 @@ newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)]
instance Monoid WallpaperList where
mempty = WallpaperList []
mappend (WallpaperList w1) (WallpaperList w2) =
WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)
WallpaperList $ M.toList $ M.fromList w2 `M.union` M.fromList w1
instance Semigroup WallpaperList where
(<>) = mappend
@@ -100,9 +100,17 @@ defWallpaperConf = WallpaperConf "" $ WallpaperList []
instance Default WallpaperConf where
def = defWallpaperConf
-- |returns the default association list (maps name to name.jpg, non-alphanumeric characters are omitted)
{-# DEPRECATED defWPNames "Use defWPNamesJpg instead" #-}
defWPNames :: [WorkspaceId] -> WallpaperList
defWPNames xs = WallpaperList $ map (\x -> (x,WallpaperFix (filter isAlphaNum x++".jpg"))) xs
defWPNames = defWPNamesJpg
-- | Return the default association list (maps @name@ to @name.jpg@, non-alphanumeric characters are omitted)
defWPNamesJpg :: [WorkspaceId] -> WallpaperList
defWPNamesJpg xs = WallpaperList $ map (\x -> (x, WallpaperFix (filter isAlphaNum x ++ ".jpg"))) xs
-- | Like 'defWPNamesJpg', but map @name@ to @name.png@ instead.
defWPNamesPng :: [WorkspaceId] -> WallpaperList
defWPNamesPng xs = WallpaperList $ map (\x -> (x, WallpaperFix (filter isAlphaNum x ++ ".png"))) xs
-- | Add this to your log hook with the workspace configuration as argument.
wallpaperSetter :: WallpaperConf -> X ()
@@ -158,7 +166,6 @@ getPicRes picpath = do
[[(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)
completeWPConf :: WallpaperConf -> X WallpaperConf
@@ -198,18 +205,18 @@ applyWallpaper parts = do
layers <- liftIO $ mapM layerCommand parts
let basepart ="convert -size " ++ show vx ++ "x" ++ show vy ++ " xc:black"
endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -"
cmd = basepart ++ (concat $ intersperse " " layers) ++ endpart
cmd = basepart ++ unwords layers ++ endpart
liftIO $ runCommand cmd
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 )
getVScreenDim = foldr (maxXY . screenRect . S.screenDetail) (0,0) . 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)
wratio = fromIntegral (rect_width rect) / fromIntegral (rect_height rect)
pratio = fromIntegral px / fromIntegral py
in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1