-----------------------------------------------------------------------------
-- |
-- Module      :  XMonadContrib.Tabbed
-- Copyright   :  (c) David Roundy
-- License     :  BSD-style (see xmonad/LICENSE)
-- 
-- Maintainer  :  email@address.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- A tabbed layout for the Xmonad Window Manager 
--
-----------------------------------------------------------------------------

module XMonadContrib.Tabbed ( 
                             -- * Usage:
                             -- $usage
                              tabbed
                            , Shrinker, shrinkText
                            , TConf (..), defaultTConf
                            ) where

import Control.Monad ( forM, liftM )
import Control.Monad.State ( gets )

import Graphics.X11.Xlib
import XMonad
import XMonadContrib.Decoration
import Operations ( focus, initColor )
import qualified StackSet as W

import XMonadContrib.NamedWindows
import XMonadContrib.LayoutHelpers ( idModify )

-- $usage
-- You can use this module with the following in your configuration file:
--
-- > import XMonadContrib.Tabbed
-- > import XMonadContrib.SimpleStacking
--
-- > defaultLayouts :: [Layout]
-- > defaultLayouts = [ simpleStacking $ tabbed shrinkText defaultTConf
-- >                 , ... ]
--
-- You can also edit the default configuration options.
--
-- > myconfig = defaultTConf { bgColor = "#FF0000"
-- >                         , textColor = "#00FF00"}
--
-- and
--
-- > defaultLayouts = [ simpleStacking $ tabbed shrinkText myconfig
-- >                 , ... ]

tabbed :: Shrinker -> Layout Window
tabbed shrinkT =  Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) }

dolay :: Shrinker -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)]
dolay _ sc (W.Stack w [] []) = return [(w,sc)]
dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy ->
    do activecolor   <- io $ initColor dpy "#BBBBBB"
       inactivecolor <- io $ initColor dpy "#888888"
       textcolor     <- io $ initColor dpy "#000000"
       bgcolor       <- io $ initColor dpy "#000000"
       let ws = W.integrate s
           ts = gentabs conf x y wid (length ws)
           tws = zip ts ws
           maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow)
           drawtab r@(Rectangle _ _ wt ht) ow d w' gc =
               do nw <- getName ow
                  tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset
                  io $ setForeground d gc tabcolor
                  io $ fillRectangles d w' gc [Rectangle 0 0 wt ht]
                  io $ setForeground d gc textcolor
                  centerText d w' gc fn r (show nw)
           centerText d w' gc fontst (Rectangle _ _ wt ht) name =
               do let (_,asc,_,_) = textExtents fontst name
                      name' = shrinkWhile shr (\n -> textWidth fontst n >
                                                     fromIntegral wt - fromIntegral (ht `div` 2)) name
                      width = textWidth fontst name'
                  io $ drawString d w' gc
                         (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2))
                         ((fromIntegral ht + fromIntegral asc) `div` 2) name'
       forM tws maketab
       return $ map (\w -> (w,shrink sc)) ws

type Shrinker = String -> [String]

shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String
shrinkWhile sh p x = sw $ sh x
    where sw [n] = n
          sw [] = ""
          sw (n:ns) | p n = sw ns
                    | otherwise = n

shrinkText :: Shrinker
shrinkText "" = [""]
shrinkText cs = cs : shrinkText (init cs)

shrink :: TConf -> Rectangle -> Rectangle
shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))

gentabs :: TConf -> Position -> Position -> Dimension -> Int -> [Rectangle]
gentabs _ _ _ _ 0 = []
gentabs c x y w num = Rectangle x y (wid - 2) (fromIntegral (tabSize c) - 2)
                      : gentabs c (x + fromIntegral wid) y (w - wid) (num - 1)
                          where wid = w `div` (fromIntegral num)