Simplify struts generation
This commit is contained in:
parent
c918dde366
commit
6de4eb5792
3 changed files with 26 additions and 36 deletions
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -3,4 +3,4 @@ import Phi.X11
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
initPhi phiDefaultXConfig { phiPanelPosition = PanelPositionBottom }
|
initPhi phiDefaultXConfig { phiPanelPosition = Bottom }
|
||||||
|
|
Reference in a new issue