{-# 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 = ShowWName a -> l a -> ModifiedLayout ShowWName l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Bool -> SWNConfig -> ShowWNState -> ShowWName a
forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
forall a. Default a => a
def ShowWNState
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 = ShowWName a -> l a -> ModifiedLayout ShowWName l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Bool -> SWNConfig -> ShowWNState -> ShowWName a
forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c ShowWNState
forall a. Maybe a
Nothing)
type ShowWNState = Maybe (TimerId, Window)
data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (ReadPrec [ShowWName a]
ReadPrec (ShowWName a)
Int -> ReadS (ShowWName a)
ReadS [ShowWName a]
(Int -> ReadS (ShowWName a))
-> ReadS [ShowWName a]
-> ReadPrec (ShowWName a)
-> ReadPrec [ShowWName a]
-> Read (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
$creadsPrec :: forall a. Int -> ReadS (ShowWName a)
readsPrec :: Int -> ReadS (ShowWName a)
$creadList :: forall a. ReadS [ShowWName a]
readList :: ReadS [ShowWName a]
$creadPrec :: forall a. ReadPrec (ShowWName a)
readPrec :: ReadPrec (ShowWName a)
$creadListPrec :: forall a. ReadPrec [ShowWName a]
readListPrec :: ReadPrec [ShowWName a]
Read, Int -> ShowWName a -> ShowS
[ShowWName a] -> ShowS
ShowWName a -> String
(Int -> ShowWName a -> ShowS)
-> (ShowWName a -> String)
-> ([ShowWName a] -> ShowS)
-> Show (ShowWName a)
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
$cshowsPrec :: forall a. Int -> ShowWName a -> ShowS
showsPrec :: Int -> ShowWName a -> ShowS
$cshow :: forall a. ShowWName a -> String
show :: ShowWName a -> String
$cshowList :: forall a. [ShowWName a] -> ShowS
showList :: [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]
(Int -> ReadS SWNConfig)
-> ReadS [SWNConfig]
-> ReadPrec SWNConfig
-> ReadPrec [SWNConfig]
-> Read SWNConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SWNConfig
readsPrec :: Int -> ReadS SWNConfig
$creadList :: ReadS [SWNConfig]
readList :: ReadS [SWNConfig]
$creadPrec :: ReadPrec SWNConfig
readPrec :: ReadPrec SWNConfig
$creadListPrec :: ReadPrec [SWNConfig]
readListPrec :: ReadPrec [SWNConfig]
Read, Int -> SWNConfig -> ShowS
[SWNConfig] -> ShowS
SWNConfig -> String
(Int -> SWNConfig -> ShowS)
-> (SWNConfig -> String)
-> ([SWNConfig] -> ShowS)
-> Show SWNConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SWNConfig -> ShowS
showsPrec :: Int -> SWNConfig -> ShowS
$cshow :: SWNConfig -> String
show :: SWNConfig -> String
$cshowList :: [SWNConfig] -> ShowS
showList :: [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)
_ = ShowWName a
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName 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 <- SomeMessage -> Maybe Event
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Int -> Event -> X (Maybe (ShowWName a)) -> X (Maybe (ShowWName a))
forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer Int
i Event
e (Window -> X ()
deleteWindow Window
w X () -> X (Maybe (ShowWName a)) -> X (Maybe (ShowWName a))
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ShowWName a) -> X (Maybe (ShowWName a))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ShowWName a)
forall a. Maybe a
Nothing)
| Just LayoutMessages
Hide <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do Window -> X ()
deleteWindow Window
w
Maybe (ShowWName a) -> X (Maybe (ShowWName a))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ShowWName a) -> X (Maybe (ShowWName a)))
-> (ShowWName a -> Maybe (ShowWName a))
-> ShowWName a
-> X (Maybe (ShowWName a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowWName a -> Maybe (ShowWName a)
forall a. a -> Maybe a
Just (ShowWName a -> X (Maybe (ShowWName a)))
-> ShowWName a -> X (Maybe (ShowWName a))
forall a b. (a -> b) -> a -> b
$ Bool -> SWNConfig -> ShowWNState -> ShowWName a
forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c ShowWNState
forall a. Maybe a
Nothing
handleMess (SWN Bool
_ SWNConfig
c ShowWNState
s) SomeMessage
m
| Just LayoutMessages
Hide <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (ShowWName a) -> X (Maybe (ShowWName a))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ShowWName a) -> X (Maybe (ShowWName a)))
-> (ShowWName a -> Maybe (ShowWName a))
-> ShowWName a
-> X (Maybe (ShowWName a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowWName a -> Maybe (ShowWName a)
forall a. a -> Maybe a
Just (ShowWName a -> X (Maybe (ShowWName a)))
-> ShowWName a -> X (Maybe (ShowWName a))
forall a b. (a -> b) -> a -> b
$ Bool -> SWNConfig -> ShowWNState -> ShowWName a
forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c ShowWNState
s
| Bool
otherwise = Maybe (ShowWName a) -> X (Maybe (ShowWName a))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ShowWName a)
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 X ()
-> X ([(a, Rectangle)], Maybe (ShowWName a))
-> X ([(a, Rectangle)], Maybe (ShowWName a))
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
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 = SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
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 = ([(a, Rectangle)], Maybe (ShowWName a))
-> X ([(a, Rectangle)], Maybe (ShowWName a))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, Maybe (ShowWName a)
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
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
n <- withWindowSet (return . S.currentTag)
f <- initXMF (swn_font c)
width <- (\Int
w -> Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n) <$> textWidthXMF d f n
(as,ds) <- textExtentsXMF f n
let hight = Position
as Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
ds
y = Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
hight Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
2) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
x = Position -> Int
forall a b. (Integral a, Num b) => a -> b
fi Position
sx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Dimension -> Int
forall a b. (Integral a, Num b) => a -> b
fi Dimension
wh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True
showWindow w
paintAndWrite w f (fi width) (fi hight) 0 (swn_bgcolor c) "" (swn_color c) (swn_bgcolor c) [AlignCenter] [n]
releaseXMF f
i <- startTimer (swn_fade c)
return (wrs, Just $ SWN False c $ Just (i,w))