    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MultiWayIf #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.ShowText
    -- Description :  Display text on the screen.
    -- Copyright   :  (c) Mario Pastorelli (2012)
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  pastorelli.mario@gmail.com
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen"
    -- which offers more features (currently)
    -----------------------------------------------------------------------------

    module XMonad.Actions.ShowText
        ( -- * Usage
          -- $usage
          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

    -- $usage
    -- You can use this module with the following in your @xmonad.hs@:
    --
    -- > import XMonad.Actions.ShowText
    --
    -- Then add the event hook handler:
    --
    -- > xmonad { handleEventHook = myHandleEventHooks <> handleTimerEvent }
    --
    -- You can then use flashText in your keybindings:
    --
    -- > ((modMask, xK_Right), flashText def 1 "->" >> nextWS)
    --

    -- | ShowText contains the map with timers as keys and created windows as values
    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

    -- | Utility to modify a ShowText
    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 -- ^ Font name
            , ShowTextConfig -> String
    st_bg   :: String -- ^ Background color
            , ShowTextConfig -> String
    st_fg   :: String -- ^ Foreground color
        }

    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"
        }

    -- | Handles timer events that notify when a window should be removed
    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

    -- | Shows a window in the center of the screen with the given text
    flashText :: ShowTextConfig
        -> Rational -- ^ number of seconds
        -> String -- ^ text to display
        -> 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)