added configration options and moved font stuff to Decorations.hs

Added a new data type to keep configuration options. tabbed now takes the shrinker and the configuration
type.
Fixed a bug related to vertical alignment of text.

darcs-hash:20070625140112-32816-bb7d5ca75803b255d450aed01b3bc91d6c834611.gz

1 files changed, 45 insertions, 30 deletions

diff --git a/Tabbed.hs b/Tabbed.hs
index a4490d2..357f01d 100644
--- a/Tabbed.hs
+++ b/Tabbed.hs
@@ -17,6 +17,7 @@ module XMonadContrib.Tabbed (
                              -- $usage
                               tabbed
                             , Shrinker, shrinkText
+                            , TConf (..), defaultTConf
                             ) where
 
 import Control.Monad ( forM, liftM )
@@ -37,42 +38,59 @@ import XMonadContrib.NamedWindows
 -- > import XMonadContrib.SimpleStacking
 --
 -- > defaultLayouts :: [Layout]
--- > defaultLayouts = [ simpleStacking $ tabbed shrinkText
+-- > defaultLayouts = [ simpleStacking $ tabbed shrinkText defaultTConf
 -- >                 , ... ]
 
-tabbed :: Shrinker -> Layout Window
-tabbed shrinkT =  Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) }
+data TConf = 
+    TConf { activeColor :: String
+          , inactiveColor :: String
+          , bgColor :: String
+          , textColor :: String
+          , fontName :: String 
+          , tabSize :: Int
+          } deriving (Show, Read)
+ 
+defaultTConf :: TConf
+defaultTConf = 
+    TConf { activeColor ="#BBBBBB"
+          , inactiveColor = "#888888"
+          , bgColor = "#000000"
+          , textColor = "#000000"
+          , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+          , tabSize = 20
+          }
 
-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"
+tabbed :: Shrinker -> TConf -> Layout Window
+tabbed shrinkT config =  Layout { doLayout = dolay shrinkT config, modifyLayout = const (return Nothing) }
+
+dolay :: Shrinker -> TConf -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)]
+dolay _ _ sc (W.Stack w [] []) = return [(w,sc)]
+dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy ->
+    do activecolor   <- io $ initColor dpy $ activeColor conf
+       inactivecolor <- io $ initColor dpy $ inactiveColor conf
+       textcolor     <- io $ initColor dpy $ textColor conf 
+       bgcolor       <- io $ initColor dpy $ bgColor conf 
        let ws = W.integrate s
-           ts = gentabs x y wid (length ws)
+           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 =
+           maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (fontName conf) (drawtab t ow) (focus ow)
+           drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn =
                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 r (show nw)
-           centerText d w' gc (Rectangle _ _ wt ht) name =
-               do fontst <- io $ loadQueryFont d "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*"
-                  io $ setFont d gc (fontFromFontStruct fontst)
-                  let (_,asc,_,_) = textExtents fontst name
+                  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'
+                         ((fromIntegral ht + fromIntegral asc) `div` 2) name'
        forM tws maketab
-       return $ map (\w -> (w,shrink sc)) ws
+       return $ map (\w -> (w,shrink conf sc)) ws
 
 type Shrinker = String -> [String]
 
@@ -87,14 +105,11 @@ shrinkText :: Shrinker
 shrinkText "" = [""]
 shrinkText cs = cs : shrinkText (init cs)
 
-shrink :: Rectangle -> Rectangle
-shrink (Rectangle x y w h) = Rectangle x (y+tabsize) w (h-tabsize)
-
-gentabs :: Position -> Position -> Dimension -> Int -> [Rectangle]
-gentabs _ _ _ 0 = []
-gentabs x y w num = Rectangle x y (wid - 2) (tabsize - 2)
-                   : gentabs (x + fromIntegral wid) y (w - wid) (num - 1)
-                              where wid = w `div` (fromIntegral num)
+shrink :: TConf -> Rectangle -> Rectangle
+shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))
 
-tabsize :: Integral a => a
-tabsize = 20
+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)