module XMonad.Hooks.WallpaperSetter (
wallpaperSetter
, WallpaperConf(..)
, Wallpaper(..)
, WallpaperList(..)
, defWallpaperConf
, defWPNamesJpg, defWPNamesPng, defWPNames
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as S
import qualified XMonad.Util.ExtensibleState as XS
import System.IO
import System.Process
import System.Directory (getHomeDirectory, doesFileExist, doesDirectoryExist, getDirectoryContents)
import System.FilePath ((</>))
import System.Random (randomRIO)
import qualified Data.Map as M
data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle)
instance ExtensionClass WCState where
initialValue :: WCState
initialValue = Maybe [WorkspaceId] -> Maybe ProcessHandle -> WCState
WCState forall a. Maybe a
Nothing forall a. Maybe a
Nothing
data Wallpaper = WallpaperFix FilePath
| WallpaperDir FilePath
deriving (Wallpaper -> Wallpaper -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wallpaper -> Wallpaper -> Bool
$c/= :: Wallpaper -> Wallpaper -> Bool
== :: Wallpaper -> Wallpaper -> Bool
$c== :: Wallpaper -> Wallpaper -> Bool
Eq, Int -> Wallpaper -> ShowS
[Wallpaper] -> ShowS
Wallpaper -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [Wallpaper] -> ShowS
$cshowList :: [Wallpaper] -> ShowS
show :: Wallpaper -> WorkspaceId
$cshow :: Wallpaper -> WorkspaceId
showsPrec :: Int -> Wallpaper -> ShowS
$cshowsPrec :: Int -> Wallpaper -> ShowS
Show, ReadPrec [Wallpaper]
ReadPrec Wallpaper
Int -> ReadS Wallpaper
ReadS [Wallpaper]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Wallpaper]
$creadListPrec :: ReadPrec [Wallpaper]
readPrec :: ReadPrec Wallpaper
$creadPrec :: ReadPrec Wallpaper
readList :: ReadS [Wallpaper]
$creadList :: ReadS [Wallpaper]
readsPrec :: Int -> ReadS Wallpaper
$creadsPrec :: Int -> ReadS Wallpaper
Read)
newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)]
deriving (Int -> WallpaperList -> ShowS
[WallpaperList] -> ShowS
WallpaperList -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WallpaperList] -> ShowS
$cshowList :: [WallpaperList] -> ShowS
show :: WallpaperList -> WorkspaceId
$cshow :: WallpaperList -> WorkspaceId
showsPrec :: Int -> WallpaperList -> ShowS
$cshowsPrec :: Int -> WallpaperList -> ShowS
Show,ReadPrec [WallpaperList]
ReadPrec WallpaperList
Int -> ReadS WallpaperList
ReadS [WallpaperList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WallpaperList]
$creadListPrec :: ReadPrec [WallpaperList]
readPrec :: ReadPrec WallpaperList
$creadPrec :: ReadPrec WallpaperList
readList :: ReadS [WallpaperList]
$creadList :: ReadS [WallpaperList]
readsPrec :: Int -> ReadS WallpaperList
$creadsPrec :: Int -> ReadS WallpaperList
Read)
instance Semigroup WallpaperList where
WallpaperList [(WorkspaceId, Wallpaper)]
w1 <> :: WallpaperList -> WallpaperList -> WallpaperList
<> WallpaperList [(WorkspaceId, Wallpaper)]
w2 =
[(WorkspaceId, Wallpaper)] -> WallpaperList
WallpaperList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(WorkspaceId, Wallpaper)]
w2 forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(WorkspaceId, Wallpaper)]
w1
instance Monoid WallpaperList where
mempty :: WallpaperList
mempty = [(WorkspaceId, Wallpaper)] -> WallpaperList
WallpaperList []
data WallpaperConf = WallpaperConf {
WallpaperConf -> WorkspaceId
wallpaperBaseDir :: FilePath
, WallpaperConf -> WallpaperList
wallpapers :: WallpaperList
} deriving (Int -> WallpaperConf -> ShowS
[WallpaperConf] -> ShowS
WallpaperConf -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WallpaperConf] -> ShowS
$cshowList :: [WallpaperConf] -> ShowS
show :: WallpaperConf -> WorkspaceId
$cshow :: WallpaperConf -> WorkspaceId
showsPrec :: Int -> WallpaperConf -> ShowS
$cshowsPrec :: Int -> WallpaperConf -> ShowS
Show, ReadPrec [WallpaperConf]
ReadPrec WallpaperConf
Int -> ReadS WallpaperConf
ReadS [WallpaperConf]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WallpaperConf]
$creadListPrec :: ReadPrec [WallpaperConf]
readPrec :: ReadPrec WallpaperConf
$creadPrec :: ReadPrec WallpaperConf
readList :: ReadS [WallpaperConf]
$creadList :: ReadS [WallpaperConf]
readsPrec :: Int -> ReadS WallpaperConf
$creadsPrec :: Int -> ReadS WallpaperConf
Read)
defWallpaperConf :: WallpaperConf
defWallpaperConf :: WallpaperConf
defWallpaperConf = WorkspaceId -> WallpaperList -> WallpaperConf
WallpaperConf WorkspaceId
"" forall a b. (a -> b) -> a -> b
$ [(WorkspaceId, Wallpaper)] -> WallpaperList
WallpaperList []
instance Default WallpaperConf where
def :: WallpaperConf
def = WallpaperConf
defWallpaperConf
{-# DEPRECATED defWPNames "Use defWPNamesJpg instead" #-}
defWPNames :: [WorkspaceId] -> WallpaperList
defWPNames :: [WorkspaceId] -> WallpaperList
defWPNames = [WorkspaceId] -> WallpaperList
defWPNamesJpg
defWPNamesJpg :: [WorkspaceId] -> WallpaperList
defWPNamesJpg :: [WorkspaceId] -> WallpaperList
defWPNamesJpg [WorkspaceId]
xs = [(WorkspaceId, Wallpaper)] -> WallpaperList
WallpaperList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\WorkspaceId
x -> (WorkspaceId
x, WorkspaceId -> Wallpaper
WallpaperFix (forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum WorkspaceId
x forall a. [a] -> [a] -> [a]
++ WorkspaceId
".jpg"))) [WorkspaceId]
xs
defWPNamesPng :: [WorkspaceId] -> WallpaperList
defWPNamesPng :: [WorkspaceId] -> WallpaperList
defWPNamesPng [WorkspaceId]
xs = [(WorkspaceId, Wallpaper)] -> WallpaperList
WallpaperList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\WorkspaceId
x -> (WorkspaceId
x, WorkspaceId -> Wallpaper
WallpaperFix (forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum WorkspaceId
x forall a. [a] -> [a] -> [a]
++ WorkspaceId
".png"))) [WorkspaceId]
xs
wallpaperSetter :: WallpaperConf -> X ()
wallpaperSetter :: WallpaperConf -> X ()
wallpaperSetter WallpaperConf
wpconf = do
WCState Maybe [WorkspaceId]
oldws Maybe ProcessHandle
h <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
[WorkspaceId]
visws <- X [WorkspaceId]
getVisibleWorkspaces
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. a -> Maybe a
Just [WorkspaceId]
visws forall a. Eq a => a -> a -> Bool
/= Maybe [WorkspaceId]
oldws) forall a b. (a -> b) -> a -> b
$ do
WallpaperConf
wpconf' <- WallpaperConf -> X WallpaperConf
completeWPConf WallpaperConf
wpconf
[(Rectangle, WorkspaceId)]
wspicpaths <- WallpaperConf -> X [(Rectangle, WorkspaceId)]
getPicPathsAndWSRects WallpaperConf
wpconf'
case Maybe ProcessHandle
h of
Maybe ProcessHandle
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ProcessHandle
pid -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
terminateProcess ProcessHandle
pid
ProcessHandle
handle <- [(Rectangle, WorkspaceId)] -> X ProcessHandle
applyWallpaper [(Rectangle, WorkspaceId)]
wspicpaths
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$ Maybe [WorkspaceId] -> Maybe ProcessHandle -> WCState
WCState (forall a. a -> Maybe a
Just [WorkspaceId]
visws) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ProcessHandle
handle
pickFrom :: [a] -> IO a
pickFrom :: forall a. [a] -> IO a
pickFrom [a]
list = do
Int
i <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0,forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list forall a. Num a => a -> a -> a
- Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a]
list forall a. [a] -> Int -> a
!! Int
i
getPicPath :: WallpaperConf -> Wallpaper -> IO (Maybe FilePath)
getPicPath :: WallpaperConf -> Wallpaper -> IO (Maybe WorkspaceId)
getPicPath WallpaperConf
conf (WallpaperDir WorkspaceId
dir) = do
Bool
direxists <- WorkspaceId -> IO Bool
doesDirectoryExist forall a b. (a -> b) -> a -> b
$ WallpaperConf -> WorkspaceId
wallpaperBaseDir WallpaperConf
conf WorkspaceId -> ShowS
</> WorkspaceId
dir
if Bool
direxists
then do [WorkspaceId]
files <- WorkspaceId -> IO [WorkspaceId]
getDirectoryContents forall a b. (a -> b) -> a -> b
$ WallpaperConf -> WorkspaceId
wallpaperBaseDir WallpaperConf
conf WorkspaceId -> ShowS
</> WorkspaceId
dir
let files' :: [WorkspaceId]
files' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId
"." forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)) [WorkspaceId]
files
WorkspaceId
file <- forall a. [a] -> IO a
pickFrom [WorkspaceId]
files'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WallpaperConf -> WorkspaceId
wallpaperBaseDir WallpaperConf
conf WorkspaceId -> ShowS
</> WorkspaceId
dir WorkspaceId -> ShowS
</> WorkspaceId
file
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getPicPath WallpaperConf
conf (WallpaperFix WorkspaceId
file) = do
Bool
exist <- WorkspaceId -> IO Bool
doesFileExist WorkspaceId
path
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
exist then forall a. a -> Maybe a
Just WorkspaceId
path else forall a. Maybe a
Nothing
where path :: WorkspaceId
path = WallpaperConf -> WorkspaceId
wallpaperBaseDir WallpaperConf
conf WorkspaceId -> ShowS
</> WorkspaceId
file
getPicRes :: FilePath -> IO (Maybe (Int,Int))
getPicRes :: WorkspaceId -> IO (Maybe (Int, Int))
getPicRes WorkspaceId
picpath = do
(Maybe Handle
_, Just Handle
outh,Maybe Handle
_,ProcessHandle
_pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> [WorkspaceId] -> CreateProcess
proc WorkspaceId
"identify" [WorkspaceId
"-format", WorkspaceId
"%w %h", WorkspaceId
picpath]) { std_out :: StdStream
std_out = StdStream
CreatePipe }
WorkspaceId
output <- Handle -> IO WorkspaceId
hGetContents Handle
outh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => ReadS a
reads (WorkspaceId -> [WorkspaceId]
words WorkspaceId
output) of
[[(Int
w,WorkspaceId
"")],[(Int
h,WorkspaceId
"")]] -> forall a. a -> Maybe a
Just (Int
w,Int
h)
[[(Int, WorkspaceId)]]
_ -> forall a. Maybe a
Nothing
completeWPConf :: WallpaperConf -> X WallpaperConf
completeWPConf :: WallpaperConf -> X WallpaperConf
completeWPConf (WallpaperConf WorkspaceId
dir (WallpaperList [(WorkspaceId, Wallpaper)]
ws)) = do
WorkspaceId
home <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO WorkspaceId
getHomeDirectory
WindowSet
winset <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let tags :: [WorkspaceId]
tags = forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
S.tag forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
S.workspaces WindowSet
winset
dir' :: WorkspaceId
dir' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
dir then WorkspaceId
home WorkspaceId -> ShowS
</> WorkspaceId
".wallpapers" else WorkspaceId
dir
ws' :: WallpaperList
ws' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(WorkspaceId, Wallpaper)]
ws then [WorkspaceId] -> WallpaperList
defWPNames [WorkspaceId]
tags else [(WorkspaceId, Wallpaper)] -> WallpaperList
WallpaperList [(WorkspaceId, Wallpaper)]
ws
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceId -> WallpaperList -> WallpaperConf
WallpaperConf WorkspaceId
dir' WallpaperList
ws')
getVisibleWorkspaces :: X [WorkspaceId]
getVisibleWorkspaces :: X [WorkspaceId]
getVisibleWorkspaces = do
WindowSet
winset <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall i l a. Workspace i l a -> i
S.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall i l a sid sd. Screen i l a sid sd -> sid
S.screen forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
winset forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
winset
getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)]
getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, WorkspaceId)]
getPicPathsAndWSRects WallpaperConf
wpconf = do
WindowSet
winset <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
[(WorkspaceId, Maybe WorkspaceId)]
paths <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(WorkspaceId, Maybe WorkspaceId)]
getPicPaths
[WorkspaceId]
visws <- X [WorkspaceId]
getVisibleWorkspaces
let visscr :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
visscr = forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
winset forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
winset
visrects :: Map WorkspaceId ScreenDetail
visrects = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
x -> ((forall i l a. Workspace i l a -> i
S.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace) Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
x, forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
x)) [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
visscr
getRect :: WorkspaceId -> Rectangle
getRect WorkspaceId
tag = ScreenDetail -> Rectangle
screenRect forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
tag Map WorkspaceId ScreenDetail
visrects
foundpaths :: [(Rectangle, WorkspaceId)]
foundpaths = [ (WorkspaceId -> Rectangle
getRect WorkspaceId
n, WorkspaceId
p) | (WorkspaceId
n, Just WorkspaceId
p) <- [(WorkspaceId, Maybe WorkspaceId)]
paths, WorkspaceId
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
visws ]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Rectangle, WorkspaceId)]
foundpaths
where getPicPaths :: IO [(WorkspaceId, Maybe WorkspaceId)]
getPicPaths = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(WorkspaceId
x,Wallpaper
y) -> WallpaperConf -> Wallpaper -> IO (Maybe WorkspaceId)
getPicPath WallpaperConf
wpconf Wallpaper
y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe WorkspaceId
p -> forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceId
x,Maybe WorkspaceId
p)) [(WorkspaceId, Wallpaper)]
wl
WallpaperList [(WorkspaceId, Wallpaper)]
wl = WallpaperConf -> WallpaperList
wallpapers WallpaperConf
wpconf
applyWallpaper :: [(Rectangle, FilePath)] -> X ProcessHandle
applyWallpaper :: [(Rectangle, WorkspaceId)] -> X ProcessHandle
applyWallpaper [(Rectangle, WorkspaceId)]
parts = do
WindowSet
winset <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let (Integer
vx,Integer
vy) = forall i l a sid.
StackSet i l a sid ScreenDetail -> (Integer, Integer)
getVScreenDim WindowSet
winset
[WorkspaceId]
layers <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Rectangle, WorkspaceId) -> IO WorkspaceId
layerCommand [(Rectangle, WorkspaceId)]
parts
let basepart :: WorkspaceId
basepart =WorkspaceId
"convert -size " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show Integer
vx forall a. [a] -> [a] -> [a]
++ WorkspaceId
"x" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show Integer
vy forall a. [a] -> [a] -> [a]
++ WorkspaceId
" xc:black"
endpart :: WorkspaceId
endpart =WorkspaceId
" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -"
cmd :: WorkspaceId
cmd = WorkspaceId
basepart forall a. [a] -> [a] -> [a]
++ [WorkspaceId] -> WorkspaceId
unwords [WorkspaceId]
layers forall a. [a] -> [a] -> [a]
++ WorkspaceId
endpart
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ WorkspaceId -> IO ProcessHandle
runCommand WorkspaceId
cmd
getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer)
getVScreenDim :: forall i l a sid.
StackSet i l a sid ScreenDetail -> (Integer, Integer)
getVScreenDim = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {a} {b}.
(Ord a, Ord b, Num a, Num b) =>
Rectangle -> (a, b) -> (a, b)
maxXY forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail) (Integer
0,Integer
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.screens
where maxXY :: Rectangle -> (a, b) -> (a, b)
maxXY (Rectangle Position
x Position
y Dimension
w Dimension
h) (a
mx,b
my) = ( forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
xforall a. Num a => a -> a -> a
+Dimension
w) forall a. Ord a => a -> a -> a
`max` a
mx
, forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
yforall a. Num a => a -> a -> a
+Dimension
h) forall a. Ord a => a -> a -> a
`max` b
my )
needsRotation :: Rectangle -> (Int,Int) -> Bool
needsRotation :: Rectangle -> (Int, Int) -> Bool
needsRotation Rectangle
rect (Int
px,Int
py) = let wratio, pratio :: Double
wratio :: Double
wratio = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_height Rectangle
rect)
pratio :: Double
pratio = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
px forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
py
in Double
wratio forall a. Ord a => a -> a -> Bool
> Double
1 Bool -> Bool -> Bool
&& Double
pratio forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
|| Double
wratio forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
pratio forall a. Ord a => a -> a -> Bool
> Double
1
layerCommand :: (Rectangle, FilePath) -> IO String
layerCommand :: (Rectangle, WorkspaceId) -> IO WorkspaceId
layerCommand (Rectangle
rect, WorkspaceId
path) = do
Maybe (Int, Int)
res <- WorkspaceId -> IO (Maybe (Int, Int))
getPicRes WorkspaceId
path
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Rectangle -> (Int, Int) -> Bool
needsRotation Rectangle
rect forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int)
res of
Maybe Bool
Nothing -> WorkspaceId
""
Just Bool
rotate -> let size :: WorkspaceId
size = forall a. Show a => a -> WorkspaceId
show (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. [a] -> [a] -> [a]
++ WorkspaceId
"x" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show (Rectangle -> Dimension
rect_height Rectangle
rect) in
WorkspaceId
" \\( '"forall a. [a] -> [a] -> [a]
++WorkspaceId
pathforall a. [a] -> [a] -> [a]
++WorkspaceId
"' "forall a. [a] -> [a] -> [a]
++(if Bool
rotate then WorkspaceId
"-rotate 90 " else WorkspaceId
"")
forall a. [a] -> [a] -> [a]
++ WorkspaceId
" -scale "forall a. [a] -> [a] -> [a]
++WorkspaceId
sizeforall a. [a] -> [a] -> [a]
++WorkspaceId
"^ -gravity center -extent "forall a. [a] -> [a] -> [a]
++WorkspaceId
sizeforall a. [a] -> [a] -> [a]
++WorkspaceId
" +gravity \\)"
forall a. [a] -> [a] -> [a]
++ WorkspaceId
" -geometry +" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show (Rectangle -> Position
rect_x Rectangle
rect) forall a. [a] -> [a] -> [a]
++ WorkspaceId
"+" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> WorkspaceId
show (Rectangle -> Position
rect_y Rectangle
rect) forall a. [a] -> [a] -> [a]
++ WorkspaceId
" -composite "