{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ShowActive
-- Copyright   :  (c) Steve Schmitt 2009
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  smschm@umich.edu
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a layout modifier that will highlight the activity status of
-- each window.  It is based on XMonad.Layout.ShowWName by Andrea Rossato.
-----------------------------------------------------------------------------

module XMonad.Layout.ShowActive
    ( -- * Usage
      -- $usage
      showActive
    , showActive'
    , defaultSAConfig
    , SAConfig(..)
    ) where

import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier
import XMonad.Util.Timer
import XMonad.Util.XUtils
import Data.List (partition)
-- $usage
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.ShowActive
-- > myLayout = layoutHook defaultConfig
-- > main = xmonad defaultConfig { layoutHook = showActive myLayout }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- Feel free to modify the hidden function put_blob to change how blobs
-- are placed - I would like to make it part of the config but I'm too
-- much of a big dummy to make it Read or Show!

-- | A layout modifier to show the activity of each window on each layout.
showActive :: (Eq a) => l a -> ModifiedLayout ShowActive l a
--showActive = ModifiedLayout (SA defaultSAConfig Nothing)
showActive = showActive' defaultSAConfig

-- | Same as showActive, allows for custom configuration.
showActive' :: (Eq a) => SAConfig -> l a -> ModifiedLayout ShowActive l a
showActive' c = ModifiedLayout (SA c Nothing)

type ShowAState = Maybe (TimerId, [Window])
data ShowActive a = SA SAConfig ShowAState deriving (Read, Show)

data SAConfig = SAC {
	sa_act_color :: String, -- ^ Color for focused window
	sa_inact_color :: String, -- ^ Color for unfocused windows
	sa_blob_size :: Int, -- ^ Size, in pixels, of blob
	sa_fade :: Rational -- ^ Time that blobs stay up
} deriving (Read, Show)

defaultSAConfig :: SAConfig
defaultSAConfig = SAC {
	sa_act_color = "red",
	sa_inact_color = "gray",
	sa_blob_size = 64,
	sa_fade = 1/2
}

instance (Eq a) => LayoutModifier ShowActive a where
    redoLayout      sn r st wrs = doShow sn r st wrs

    handleMess (SA _ s) m = case fromMessage m of
    	Just e -> case s of
    		Just (i,ws) -> handleTimer i e (deleteWindows ws >> return Nothing)
    		Nothing -> return Nothing
    	_ -> return Nothing

doShow :: (Eq a) => ShowActive a -> Rectangle -> S.Stack a -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowActive a))
doShow (SA c (Just (_,ws))) r st wrs = deleteWindows ws >> flashName c r st wrs
doShow (SA c  Nothing    ) r st wrs = flashName c r st wrs

flashName :: (Eq a) => SAConfig -> Rectangle -> S.Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowActive a))
flashName c _ st wrs = do
  d <- asks display
  let (act_w,ina_w) = partition (\(w,_) -> w == S.focus st) wrs
  let cnr act (_,r) = do
      let blob_d@(Rectangle _ _ w h) = put_blob c r
      gw <- createNewWindow blob_d Nothing "" True
      showWindow gw
      paintWindow gw w h 0 ((if act then sa_act_color else sa_inact_color) c) "black"
      return gw
  act_blobs <- mapM (cnr True) act_w
  ina_blobs <- mapM (cnr False) ina_w
  io $ sync d False
  i <- startTimer (sa_fade c)
  return (wrs, Just $ SA c $ Just (i,act_blobs ++ ina_blobs))

put_blob :: SAConfig -> Rectangle -> Rectangle
put_blob c (Rectangle x y w h) = let
	bs = sa_blob_size c `min` (fi w) `min` (fi h)
	cx = (fi x) + (fi w) `div` 2 - (bs `div` 2) :: Int
	cy = (fi y) + (fi h) `div` 2 - (bs `div` 2) :: Int
	in Rectangle (fi cx) (fi cy) (fi bs) (fi bs)