From ec3e73600701273ef5f377dcd7cf4171aceb565e Mon Sep 17 00:00:00 2001
From: Andrea Rossato <andrea.rossato@unibz.it>
Date: Sun, 17 Jun 2007 12:42:19 +0200
Subject: Tabbed.hs: fixed centerText issues and some binding shadowing
 warnings

This patch fixes the centerText issue due to the inappropriate use of
textExtends and textWidth. Those functions need a FontStruct id to
operate, and this cannot be retrieved with queryFont (see comments in
Graphics.X11.Xlib.Font).
So we now get the FontStruct with loadQueryFont, we set the default
Xorg fonts and we calculate things for (vertical and horizontal)
centering.
It also removes some binding shadows compiler warnings

darcs-hash:20070617104219-32816-1dec65118dfaca35b41f9eb2ebcaa5b02e77e0c0.gz
---
 Tabbed.hs | 32 +++++++++++++++-----------------
 1 file changed, 15 insertions(+), 17 deletions(-)

(limited to 'Tabbed.hs')

diff --git a/Tabbed.hs b/Tabbed.hs
index 6a6a16a..f98fb0b 100644
--- a/Tabbed.hs
+++ b/Tabbed.hs
@@ -44,32 +44,30 @@ tabbed =  Layout { doLayout = dolay, modifyLayout = const (return Nothing) }
 
 dolay :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)]
 dolay sc (W.Stack w [] []) = return [(w,sc)]
-dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \d ->
-    do activecolor   <- io $ initColor d "#BBBBBB"
-       inactivecolor <- io $ initColor d "#888888"
-       textcolor     <- io $ initColor d "#000000"
-       bgcolor       <- io $ initColor d "#000000"
+dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = 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 x y wid (length ws)
            tws = zip ts ws
-           maketab (t,w) = newDecoration w t 1 bgcolor activecolor (drawtab t w) (focus w)
-           drawtab r@(Rectangle _ _ wt ht) w d w' gc =
-               do nw <- getName w
-                  tabcolor <- (maybe inactivecolor (\focusw -> if focusw == w then activecolor else inactivecolor) . W.peek) `liftM` gets windowset
+           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 r (show nw)
            centerText d w' gc (Rectangle _ _ wt ht) name =
-               do font <- io (fontFromGC d gc >>= queryFont d)
-                  -- let (_,namew,nameh,_) = textExtents font name -- textExtents causes a crash!
-                  -- let nameh = ht `div` 2
-                  --     namew = textWidth font name -- textWidth also causes a crash!
-                  let nameh = ht - 6
-                      namew = wt - 10
+               do fontst <- io $ loadQueryFont d "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*"
+                  io $ setFont d gc (fontFromFontStruct fontst)
+                  let (_,asc,_,_) = textExtents fontst name
+                      width = textWidth fontst name
                   io $ drawString d w' gc
-                         (fromIntegral (wt `div` 2) - fromIntegral (namew `div` 2))
-                         (fromIntegral (ht `div` 2) + fromIntegral (nameh `div` 2)) name
+                         (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2))
+                         (fromIntegral ht - fromIntegral (asc `div` 2)) name
        forM tws maketab
        return [ (w,shrink sc) ]
 
-- 
cgit v1.2.3