{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE CPP #-}
module XMonad.Layout.ShowWName
(
showWName
, showWName'
, def
, SWNConfig(..)
, ShowWName
) where
import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier
import XMonad.Util.Font
import XMonad.Util.Timer
import XMonad.Util.XUtils
showWName :: l a -> ModifiedLayout ShowWName l a
showWName :: forall (l :: * -> *) a. l a -> ModifiedLayout ShowWName l a
showWName = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True forall a. Default a => a
def forall a. Maybe a
Nothing)
showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a
showWName' :: forall (l :: * -> *) a.
SWNConfig -> l a -> ModifiedLayout ShowWName l a
showWName' SWNConfig
c = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c forall a. Maybe a
Nothing)
type ShowWNState = Maybe (TimerId, Window)
data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (ReadPrec [ShowWName a]
ReadPrec (ShowWName a)
ReadS [ShowWName a]
forall a. ReadPrec [ShowWName a]
forall a. ReadPrec (ShowWName a)
forall a. Int -> ReadS (ShowWName a)
forall a. ReadS [ShowWName a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShowWName a]
$creadListPrec :: forall a. ReadPrec [ShowWName a]
readPrec :: ReadPrec (ShowWName a)
$creadPrec :: forall a. ReadPrec (ShowWName a)
readList :: ReadS [ShowWName a]
$creadList :: forall a. ReadS [ShowWName a]
readsPrec :: Int -> ReadS (ShowWName a)
$creadsPrec :: forall a. Int -> ReadS (ShowWName a)
Read, Int -> ShowWName a -> ShowS
forall a. Int -> ShowWName a -> ShowS
forall a. [ShowWName a] -> ShowS
forall a. ShowWName a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShowWName a] -> ShowS
$cshowList :: forall a. [ShowWName a] -> ShowS
show :: ShowWName a -> String
$cshow :: forall a. ShowWName a -> String
showsPrec :: Int -> ShowWName a -> ShowS
$cshowsPrec :: forall a. Int -> ShowWName a -> ShowS
Show)
data SWNConfig =
SWNC { SWNConfig -> String
swn_font :: String
, SWNConfig -> String
swn_bgcolor :: String
, SWNConfig -> String
swn_color :: String
, SWNConfig -> Rational
swn_fade :: Rational
} deriving (ReadPrec [SWNConfig]
ReadPrec SWNConfig
Int -> ReadS SWNConfig
ReadS [SWNConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SWNConfig]
$creadListPrec :: ReadPrec [SWNConfig]
readPrec :: ReadPrec SWNConfig
$creadPrec :: ReadPrec SWNConfig
readList :: ReadS [SWNConfig]
$creadList :: ReadS [SWNConfig]
readsPrec :: Int -> ReadS SWNConfig
$creadsPrec :: Int -> ReadS SWNConfig
Read, Int -> SWNConfig -> ShowS
[SWNConfig] -> ShowS
SWNConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SWNConfig] -> ShowS
$cshowList :: [SWNConfig] -> ShowS
show :: SWNConfig -> String
$cshow :: SWNConfig -> String
showsPrec :: Int -> SWNConfig -> ShowS
$cshowsPrec :: Int -> SWNConfig -> ShowS
Show)
instance Default SWNConfig where
def :: SWNConfig
def =
#ifdef XFT
SWNC { swn_font :: String
swn_font = String
"xft:monospace-20"
#else
SWNC { swn_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
#endif
, swn_bgcolor :: String
swn_bgcolor = String
"black"
, swn_color :: String
swn_color = String
"white"
, swn_fade :: Rational
swn_fade = Rational
1
}
instance LayoutModifier ShowWName a where
redoLayout :: ShowWName a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
redoLayout ShowWName a
sn Rectangle
r Maybe (Stack a)
_ = forall a.
ShowWName a
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
doShow ShowWName a
sn Rectangle
r
handleMess :: ShowWName a -> SomeMessage -> X (Maybe (ShowWName a))
handleMess (SWN Bool
_ SWNConfig
c (Just (Int
i,Window
w))) SomeMessage
m
| Just Event
e <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer Int
i Event
e (Window -> X ()
deleteWindow Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
| Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do Window -> X ()
deleteWindow Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c forall a. Maybe a
Nothing
handleMess (SWN Bool
_ SWNConfig
c ShowWNState
s) SomeMessage
m
| Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c ShowWNState
s
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
doShow :: forall a.
ShowWName a
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
doShow (SWN Bool
True SWNConfig
c (Just (Int
_,Window
w))) Rectangle
r [(a, Rectangle)]
wrs = Window -> X ()
deleteWindow Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a.
SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName SWNConfig
c Rectangle
r [(a, Rectangle)]
wrs
doShow (SWN Bool
True SWNConfig
c ShowWNState
Nothing ) Rectangle
r [(a, Rectangle)]
wrs = forall a.
SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName SWNConfig
c Rectangle
r [(a, Rectangle)]
wrs
doShow (SWN Bool
False SWNConfig
_ ShowWNState
_ ) Rectangle
_ [(a, Rectangle)]
wrs = forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. Maybe a
Nothing)
flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName :: forall a.
SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName SWNConfig
c (Rectangle Position
sx Position
sy Dimension
wh Dimension
ht) [(a, Rectangle)]
wrs = do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
String
n <- forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
S.currentTag)
XMonadFont
f <- String -> X XMonadFont
initXMF (SWNConfig -> String
swn_font SWNConfig
c)
Int
width <- (\Int
w -> Int
w forall a. Num a => a -> a -> a
+ Int
w forall a. Integral a => a -> a -> a
`div` forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
d XMonadFont
f String
n
(Position
as,Position
ds) <- forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
f String
n
let hight :: Position
hight = Position
as forall a. Num a => a -> a -> a
+ Position
ds
y :: Position
y = forall a b. (Integral a, Num b) => a -> b
fi Position
sy forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht forall a. Num a => a -> a -> a
- Position
hight forall a. Num a => a -> a -> a
+ Position
2) forall a. Integral a => a -> a -> a
`div` Position
2
x :: Int
x = forall a b. (Integral a, Num b) => a -> b
fi Position
sx forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi Dimension
wh forall a. Num a => a -> a -> a
- Int
width forall a. Num a => a -> a -> a
+ Int
2) forall a. Integral a => a -> a -> a
`div` Int
2
Window
w <- Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi Int
x) (forall a b. (Integral a, Num b) => a -> b
fi Position
y) (forall a b. (Integral a, Num b) => a -> b
fi Int
width) (forall a b. (Integral a, Num b) => a -> b
fi Position
hight)) forall a. Maybe a
Nothing String
"" Bool
True
Window -> X ()
showWindow Window
w
Window
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> X ()
paintAndWrite Window
w XMonadFont
f (forall a b. (Integral a, Num b) => a -> b
fi Int
width) (forall a b. (Integral a, Num b) => a -> b
fi Position
hight) Dimension
0 (SWNConfig -> String
swn_bgcolor SWNConfig
c) String
"" (SWNConfig -> String
swn_color SWNConfig
c) (SWNConfig -> String
swn_bgcolor SWNConfig
c) [Align
AlignCenter] [String
n]
XMonadFont -> X ()
releaseXMF XMonadFont
f
Int
i <- Rational -> X Int
startTimer (SWNConfig -> Rational
swn_fade SWNConfig
c)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
False SWNConfig
c forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
i,Window
w))