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
This commit is contained in:
Andrea Rossato
2007-06-17 10:42:19 +00:00
parent c3158387c7
commit 0b86826b77

View File

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