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

View file

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

View file

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