{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
module XMonad.Actions.ShowText
(
def
, handleTimerEvent
, flashText
, ShowTextConfig(..)
) where
import Data.Map (Map,empty,insert,lookup)
import Prelude hiding (lookup)
import XMonad
import XMonad.Prelude (All, fi, listToMaybe)
import XMonad.StackSet (current,screen)
import XMonad.Util.Font (Align(AlignCenter)
, initXMF
, releaseXMF
, textExtentsXMF
, textWidthXMF)
import XMonad.Util.Timer (startTimer)
import XMonad.Util.XUtils (createNewWindow
, deleteWindow
, showWindow
, paintAndWrite)
import qualified XMonad.Util.ExtensibleState as ES
newtype ShowText = ShowText (Map Atom Window)
deriving (ReadPrec [ShowText]
ReadPrec ShowText
Int -> ReadS ShowText
ReadS [ShowText]
(Int -> ReadS ShowText)
-> ReadS [ShowText]
-> ReadPrec ShowText
-> ReadPrec [ShowText]
-> Read ShowText
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ShowText
readsPrec :: Int -> ReadS ShowText
$creadList :: ReadS [ShowText]
readList :: ReadS [ShowText]
$creadPrec :: ReadPrec ShowText
readPrec :: ReadPrec ShowText
$creadListPrec :: ReadPrec [ShowText]
readListPrec :: ReadPrec [ShowText]
Read,Int -> ShowText -> ShowS
[ShowText] -> ShowS
ShowText -> String
(Int -> ShowText -> ShowS)
-> (ShowText -> String) -> ([ShowText] -> ShowS) -> Show ShowText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowText -> ShowS
showsPrec :: Int -> ShowText -> ShowS
$cshow :: ShowText -> String
show :: ShowText -> String
$cshowList :: [ShowText] -> ShowS
showList :: [ShowText] -> ShowS
Show)
instance ExtensionClass ShowText where
initialValue :: ShowText
initialValue = Map Atom Atom -> ShowText
ShowText Map Atom Atom
forall k a. Map k a
empty
modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText
modShowText :: (Map Atom Atom -> Map Atom Atom) -> ShowText -> ShowText
modShowText Map Atom Atom -> Map Atom Atom
f (ShowText Map Atom Atom
m) = Map Atom Atom -> ShowText
ShowText (Map Atom Atom -> ShowText) -> Map Atom Atom -> ShowText
forall a b. (a -> b) -> a -> b
$ Map Atom Atom -> Map Atom Atom
f Map Atom Atom
m
data ShowTextConfig =
STC { ShowTextConfig -> String
st_font :: String
, ShowTextConfig -> String
st_bg :: String
, ShowTextConfig -> String
st_fg :: String
}
instance Default ShowTextConfig where
def :: ShowTextConfig
def =
#ifdef XFT
STC { st_font :: String
st_font = String
"xft:monospace-20"
#else
STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
#endif
, st_bg :: String
st_bg = String
"black"
, st_fg :: String
st_fg = String
"white"
}
handleTimerEvent :: Event -> X All
handleTimerEvent :: Event -> X All
handleTimerEvent (ClientMessageEvent ScreenNumber
_ CULong
_ Bool
_ Display
dis Atom
_ Atom
mtyp [CInt]
d) = do
(ShowText m) <- X ShowText
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
ES.get :: X ShowText
a <- io $ internAtom dis "XMONAD_TIMER" False
if | mtyp == a, Just dh <- listToMaybe d ->
whenJust (lookup (fromIntegral dh) m) deleteWindow
| otherwise -> pure ()
mempty
handleTimerEvent Event
_ = X All
forall a. Monoid a => a
mempty
flashText :: ShowTextConfig
-> Rational
-> String
-> X ()
flashText :: ShowTextConfig -> Rational -> String -> X ()
flashText ShowTextConfig
c Rational
i String
s = do
f <- String -> X XMonadFont
initXMF (ShowTextConfig -> String
st_font ShowTextConfig
c)
d <- asks display
sc <- gets $ fi . screen . current . windowset
width <- textWidthXMF d f s
(as,ds) <- textExtentsXMF f s
let hight = Position
as Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
ds
ht = Display -> ScreenNumber -> CInt
displayHeight Display
d ScreenNumber
sc
wh = Display -> ScreenNumber -> CInt
displayWidth Display
d ScreenNumber
sc
y = (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
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 = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
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 (st_bg c) ""
(st_fg c) (st_bg c) [AlignCenter] [s]
releaseXMF f
io $ sync d False
t <- startTimer i
ES.modify $ modShowText (insert (fromIntegral t) w)