Simplify struts generation

This commit is contained in:
Matthias Schiffer 2011-07-12 14:41:25 +02:00
parent c918dde366
commit 6de4eb5792
3 changed files with 26 additions and 36 deletions

View file

@ -1,6 +1,7 @@
{-# LANGUAGE ExistentialQuantification #-}
module Phi.Panel ( Panel(..)
module Phi.Panel ( Position(..)
, Panel(..)
, PanelClass(..)
, (<~>)
, separator
@ -8,6 +9,8 @@ module Phi.Panel ( Panel(..)
import Data.Function
data Position = Top | Bottom
class PanelClass a where
minSize :: a -> Int

View file

@ -1,7 +1,6 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Phi.X11 ( PanelPosition(..)
, PhiXConfig(..)
module Phi.X11 ( PhiXConfig(..)
, phiDefaultXConfig
, initPhi
) where
@ -17,10 +16,10 @@ import Data.Bits
import Control.Monad.State
import Control.Monad.Trans
data PanelPosition = PanelPositionTop | PanelPositionBottom
import qualified Phi.Panel as Panel
data PhiXConfig = PhiXConfig { phiXScreenInfo :: Display -> IO [Rectangle]
, phiPanelPosition :: PanelPosition
, phiPanelPosition :: Panel.Position
, phiPanelSize :: Int
}
@ -44,7 +43,7 @@ runPhi st (Phi a) = runStateT a st
phiDefaultXConfig = PhiXConfig { phiXScreenInfo = getScreenInfo
, phiPanelPosition = PanelPositionTop
, phiPanelPosition = Panel.Top
, phiPanelSize = 24
}
@ -184,33 +183,21 @@ setStruts panel = do
area = panelArea panel
(_, _, _, _, rootHeight, _, _) <- liftIO $ getGeometry disp rootwin
let struts = case position of
PanelPositionTop -> [ 0
, 0
, (fromIntegral $ rect_y area) + (fromIntegral $ rect_height area)
, 0
, 0
, 0
, 0
, 0
, (fromIntegral $ rect_x area)
, (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
, 0
, 0
]
PanelPositionBottom -> [ 0
, 0
, 0
, (fromIntegral rootHeight) - (fromIntegral $ rect_y area)
, 0
, 0
, 0
, 0
, 0
, 0
, (fromIntegral $ rect_x area)
, (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
]
let struts = [makeStruts i | i <- [0..11]]
where
makeTopStruts 2 = (fromIntegral $ rect_y area) + (fromIntegral $ rect_height area)
makeTopStruts 8 = (fromIntegral $ rect_x area)
makeTopStruts 9 = (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
makeTopStruts _ = 0
makeBottomStruts 3 = (fromIntegral rootHeight) - (fromIntegral $ rect_y area)
makeBottomStruts 10 = (fromIntegral $ rect_x area)
makeBottomStruts 11 = (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
makeBottomStruts _ = 0
makeStruts = case position of
Panel.Top -> makeTopStruts
Panel.Bottom -> makeBottomStruts
liftIO $ do
atom_NET_WM_STRUT <- internAtom disp "_NET_WM_STRUT" False
@ -222,8 +209,8 @@ setStruts panel = do
panelBounds :: PhiXConfig -> Rectangle -> Rectangle
panelBounds config screenBounds = case phiPanelPosition config of
PanelPositionTop -> screenBounds { rect_height = fromIntegral $ phiPanelSize config }
PanelPositionBottom -> screenBounds { rect_height = fromIntegral $ phiPanelSize config,
Panel.Top -> screenBounds { rect_height = fromIntegral $ phiPanelSize config }
Panel.Bottom -> screenBounds { rect_height = fromIntegral $ phiPanelSize config,
rect_y = (rect_y screenBounds) + (fromIntegral $ rect_height screenBounds) - (fromIntegral $ phiPanelSize config) }
withRectangle :: Rectangle -> (Position -> Position -> Dimension -> Dimension -> a) -> a

View file

@ -3,4 +3,4 @@ import Phi.X11
main :: IO ()
main = do
initPhi phiDefaultXConfig { phiPanelPosition = PanelPositionBottom }
initPhi phiDefaultXConfig { phiPanelPosition = Bottom }