module Graphics.UI.GIGtkStrut where import Control.Monad import Control.Monad.IO.Class import Control.Monad.Fail (MonadFail) import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.Int import Data.Maybe import qualified Data.Text as T import qualified GI.Gdk as Gdk import qualified GI.Gtk as Gtk import Graphics.UI.EWMHStrut data StrutPosition = TopPos | BottomPos | LeftPos | RightPos deriving (Int -> StrutPosition -> ShowS [StrutPosition] -> ShowS StrutPosition -> String (Int -> StrutPosition -> ShowS) -> (StrutPosition -> String) -> ([StrutPosition] -> ShowS) -> Show StrutPosition forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [StrutPosition] -> ShowS $cshowList :: [StrutPosition] -> ShowS show :: StrutPosition -> String $cshow :: StrutPosition -> String showsPrec :: Int -> StrutPosition -> ShowS $cshowsPrec :: Int -> StrutPosition -> ShowS Show, ReadPrec [StrutPosition] ReadPrec StrutPosition Int -> ReadS StrutPosition ReadS [StrutPosition] (Int -> ReadS StrutPosition) -> ReadS [StrutPosition] -> ReadPrec StrutPosition -> ReadPrec [StrutPosition] -> Read StrutPosition forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [StrutPosition] $creadListPrec :: ReadPrec [StrutPosition] readPrec :: ReadPrec StrutPosition $creadPrec :: ReadPrec StrutPosition readList :: ReadS [StrutPosition] $creadList :: ReadS [StrutPosition] readsPrec :: Int -> ReadS StrutPosition $creadsPrec :: Int -> ReadS StrutPosition Read, StrutPosition -> StrutPosition -> Bool (StrutPosition -> StrutPosition -> Bool) -> (StrutPosition -> StrutPosition -> Bool) -> Eq StrutPosition forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: StrutPosition -> StrutPosition -> Bool $c/= :: StrutPosition -> StrutPosition -> Bool == :: StrutPosition -> StrutPosition -> Bool $c== :: StrutPosition -> StrutPosition -> Bool Eq) data StrutAlignment = Beginning | Center | End deriving (Int -> StrutAlignment -> ShowS [StrutAlignment] -> ShowS StrutAlignment -> String (Int -> StrutAlignment -> ShowS) -> (StrutAlignment -> String) -> ([StrutAlignment] -> ShowS) -> Show StrutAlignment forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [StrutAlignment] -> ShowS $cshowList :: [StrutAlignment] -> ShowS show :: StrutAlignment -> String $cshow :: StrutAlignment -> String showsPrec :: Int -> StrutAlignment -> ShowS $cshowsPrec :: Int -> StrutAlignment -> ShowS Show, ReadPrec [StrutAlignment] ReadPrec StrutAlignment Int -> ReadS StrutAlignment ReadS [StrutAlignment] (Int -> ReadS StrutAlignment) -> ReadS [StrutAlignment] -> ReadPrec StrutAlignment -> ReadPrec [StrutAlignment] -> Read StrutAlignment forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [StrutAlignment] $creadListPrec :: ReadPrec [StrutAlignment] readPrec :: ReadPrec StrutAlignment $creadPrec :: ReadPrec StrutAlignment readList :: ReadS [StrutAlignment] $creadList :: ReadS [StrutAlignment] readsPrec :: Int -> ReadS StrutAlignment $creadsPrec :: Int -> ReadS StrutAlignment Read, StrutAlignment -> StrutAlignment -> Bool (StrutAlignment -> StrutAlignment -> Bool) -> (StrutAlignment -> StrutAlignment -> Bool) -> Eq StrutAlignment forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: StrutAlignment -> StrutAlignment -> Bool $c/= :: StrutAlignment -> StrutAlignment -> Bool == :: StrutAlignment -> StrutAlignment -> Bool $c== :: StrutAlignment -> StrutAlignment -> Bool Eq) data StrutSize = ExactSize Int32 | ScreenRatio Rational deriving (Int -> StrutSize -> ShowS [StrutSize] -> ShowS StrutSize -> String (Int -> StrutSize -> ShowS) -> (StrutSize -> String) -> ([StrutSize] -> ShowS) -> Show StrutSize forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [StrutSize] -> ShowS $cshowList :: [StrutSize] -> ShowS show :: StrutSize -> String $cshow :: StrutSize -> String showsPrec :: Int -> StrutSize -> ShowS $cshowsPrec :: Int -> StrutSize -> ShowS Show, ReadPrec [StrutSize] ReadPrec StrutSize Int -> ReadS StrutSize ReadS [StrutSize] (Int -> ReadS StrutSize) -> ReadS [StrutSize] -> ReadPrec StrutSize -> ReadPrec [StrutSize] -> Read StrutSize forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [StrutSize] $creadListPrec :: ReadPrec [StrutSize] readPrec :: ReadPrec StrutSize $creadPrec :: ReadPrec StrutSize readList :: ReadS [StrutSize] $creadList :: ReadS [StrutSize] readsPrec :: Int -> ReadS StrutSize $creadsPrec :: Int -> ReadS StrutSize Read, StrutSize -> StrutSize -> Bool (StrutSize -> StrutSize -> Bool) -> (StrutSize -> StrutSize -> Bool) -> Eq StrutSize forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: StrutSize -> StrutSize -> Bool $c/= :: StrutSize -> StrutSize -> Bool == :: StrutSize -> StrutSize -> Bool $c== :: StrutSize -> StrutSize -> Bool Eq) data StrutConfig = StrutConfig { StrutConfig -> StrutSize strutWidth :: StrutSize , StrutConfig -> StrutSize strutHeight :: StrutSize , StrutConfig -> Int32 strutXPadding :: Int32 , StrutConfig -> Int32 strutYPadding :: Int32 , StrutConfig -> Maybe Int32 strutMonitor :: Maybe Int32 , StrutConfig -> StrutPosition strutPosition :: StrutPosition , StrutConfig -> StrutAlignment strutAlignment :: StrutAlignment , StrutConfig -> Maybe Text strutDisplayName :: Maybe T.Text } deriving (Int -> StrutConfig -> ShowS [StrutConfig] -> ShowS StrutConfig -> String (Int -> StrutConfig -> ShowS) -> (StrutConfig -> String) -> ([StrutConfig] -> ShowS) -> Show StrutConfig forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [StrutConfig] -> ShowS $cshowList :: [StrutConfig] -> ShowS show :: StrutConfig -> String $cshow :: StrutConfig -> String showsPrec :: Int -> StrutConfig -> ShowS $cshowsPrec :: Int -> StrutConfig -> ShowS Show, StrutConfig -> StrutConfig -> Bool (StrutConfig -> StrutConfig -> Bool) -> (StrutConfig -> StrutConfig -> Bool) -> Eq StrutConfig forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: StrutConfig -> StrutConfig -> Bool $c/= :: StrutConfig -> StrutConfig -> Bool == :: StrutConfig -> StrutConfig -> Bool $c== :: StrutConfig -> StrutConfig -> Bool Eq) defaultStrutConfig :: StrutConfig defaultStrutConfig = StrutConfig :: StrutSize -> StrutSize -> Int32 -> Int32 -> Maybe Int32 -> StrutPosition -> StrutAlignment -> Maybe Text -> StrutConfig StrutConfig { strutWidth :: StrutSize strutWidth = Rational -> StrutSize ScreenRatio 1 , strutHeight :: StrutSize strutHeight = Rational -> StrutSize ScreenRatio 1 , strutXPadding :: Int32 strutXPadding = 0 , strutYPadding :: Int32 strutYPadding = 0 , strutMonitor :: Maybe Int32 strutMonitor = Maybe Int32 forall a. Maybe a Nothing , strutPosition :: StrutPosition strutPosition = StrutPosition TopPos , strutAlignment :: StrutAlignment strutAlignment = StrutAlignment Beginning , strutDisplayName :: Maybe Text strutDisplayName = Maybe Text forall a. Maybe a Nothing } buildStrutWindow :: (MonadFail m, MonadIO m) => StrutConfig -> m Gtk.Window buildStrutWindow :: StrutConfig -> m Window buildStrutWindow config :: StrutConfig config = do Window window <- WindowType -> m Window forall (m :: * -> *). (HasCallStack, MonadIO m) => WindowType -> m Window Gtk.windowNew WindowType Gtk.WindowTypeToplevel StrutConfig -> Window -> m () forall (m :: * -> *). (MonadFail m, MonadIO m) => StrutConfig -> Window -> m () setupStrutWindow StrutConfig config Window window Window -> m Window forall (m :: * -> *) a. Monad m => a -> m a return Window window setupStrutWindow :: (MonadFail m, MonadIO m) => StrutConfig -> Gtk.Window -> m () setupStrutWindow :: StrutConfig -> Window -> m () setupStrutWindow StrutConfig { strutWidth :: StrutConfig -> StrutSize strutWidth = StrutSize widthSize , strutHeight :: StrutConfig -> StrutSize strutHeight = StrutSize heightSize , strutXPadding :: StrutConfig -> Int32 strutXPadding = Int32 xpadding , strutYPadding :: StrutConfig -> Int32 strutYPadding = Int32 ypadding , strutMonitor :: StrutConfig -> Maybe Int32 strutMonitor = Maybe Int32 monitorNumber , strutPosition :: StrutConfig -> StrutPosition strutPosition = StrutPosition position , strutAlignment :: StrutConfig -> StrutAlignment strutAlignment = StrutAlignment alignment , strutDisplayName :: StrutConfig -> Maybe Text strutDisplayName = Maybe Text displayName } window :: Window window = do Just display :: Display display <- m (Maybe Display) -> (Text -> m (Maybe Display)) -> Maybe Text -> m (Maybe Display) forall b a. b -> (a -> b) -> Maybe a -> b maybe m (Maybe Display) forall (m :: * -> *). (HasCallStack, MonadIO m) => m (Maybe Display) Gdk.displayGetDefault Text -> m (Maybe Display) forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m (Maybe Display) Gdk.displayOpen Maybe Text displayName Just monitor :: Monitor monitor <- m (Maybe Monitor) -> (Int32 -> m (Maybe Monitor)) -> Maybe Int32 -> m (Maybe Monitor) forall b a. b -> (a -> b) -> Maybe a -> b maybe (Display -> m (Maybe Monitor) forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsDisplay a) => a -> m (Maybe Monitor) Gdk.displayGetPrimaryMonitor Display display) (Display -> Int32 -> m (Maybe Monitor) forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsDisplay a) => a -> Int32 -> m (Maybe Monitor) Gdk.displayGetMonitor Display display) Maybe Int32 monitorNumber Screen screen <- Display -> m Screen forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsDisplay a) => a -> m Screen Gdk.displayGetDefaultScreen Display display Int32 monitorCount <- Display -> m Int32 forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsDisplay a) => a -> m Int32 Gdk.displayGetNMonitors Display display [Monitor] allMonitors <- [Maybe Monitor] -> [Monitor] forall a. [Maybe a] -> [a] catMaybes ([Maybe Monitor] -> [Monitor]) -> m [Maybe Monitor] -> m [Monitor] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Int32 -> m (Maybe Monitor)) -> [Int32] -> m [Maybe Monitor] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (Display -> Int32 -> m (Maybe Monitor) forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsDisplay a) => a -> Int32 -> m (Maybe Monitor) Gdk.displayGetMonitor Display display) [0..(Int32 monitorCountInt32 -> Int32 -> Int32 forall a. Num a => a -> a -> a -1)] [Rectangle] allGeometries <- (Monitor -> m Rectangle) -> [Monitor] -> m [Rectangle] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM Monitor -> m Rectangle forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsMonitor a) => a -> m Rectangle Gdk.monitorGetGeometry [Monitor] allMonitors let getFullY :: Rectangle -> f Int32 getFullY geometry :: Rectangle geometry = Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a (+) (Int32 -> Int32 -> Int32) -> f Int32 -> f (Int32 -> Int32) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Rectangle -> f Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleY Rectangle geometry f (Int32 -> Int32) -> f Int32 -> f Int32 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Rectangle -> f Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleHeight Rectangle geometry getFullX :: Rectangle -> f Int32 getFullX geometry :: Rectangle geometry = Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a (+) (Int32 -> Int32 -> Int32) -> f Int32 -> f (Int32 -> Int32) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Rectangle -> f Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleX Rectangle geometry f (Int32 -> Int32) -> f Int32 -> f Int32 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Rectangle -> f Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleWidth Rectangle geometry Int32 screenWidth <- [Int32] -> Int32 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int32] -> Int32) -> m [Int32] -> m Int32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Rectangle -> m Int32) -> [Rectangle] -> m [Int32] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM Rectangle -> m Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 getFullX [Rectangle] allGeometries Int32 screenHeight <- [Int32] -> Int32 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int32] -> Int32) -> m [Int32] -> m Int32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Rectangle -> m Int32) -> [Rectangle] -> m [Int32] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM Rectangle -> m Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 getFullY [Rectangle] allGeometries Window -> WindowTypeHint -> m () forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsWindow a) => a -> WindowTypeHint -> m () Gtk.windowSetTypeHint Window window WindowTypeHint Gdk.WindowTypeHintDock Geometry geometry <- m Geometry forall (m :: * -> *). MonadIO m => m Geometry Gdk.newZeroGeometry Rectangle monitorGeometry <- Monitor -> m Rectangle forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsMonitor a) => a -> m Rectangle Gdk.monitorGetGeometry Monitor monitor Int32 monitorWidth <- Rectangle -> m Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleWidth Rectangle monitorGeometry Int32 monitorHeight <- Rectangle -> m Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleHeight Rectangle monitorGeometry Int32 monitorX <- Rectangle -> m Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleX Rectangle monitorGeometry Int32 monitorY <- Rectangle -> m Int32 forall (m :: * -> *). MonadIO m => Rectangle -> m Int32 Gdk.getRectangleY Rectangle monitorGeometry let width :: Int32 width = case StrutSize widthSize of ExactSize w :: Int32 w -> Int32 w ScreenRatio p :: Rational p -> Rational -> Int32 forall a b. (RealFrac a, Integral b) => a -> b floor (Rational -> Int32) -> Rational -> Int32 forall a b. (a -> b) -> a -> b $ Rational p Rational -> Rational -> Rational forall a. Num a => a -> a -> a * Int32 -> Rational forall a b. (Integral a, Num b) => a -> b fromIntegral (Int32 monitorWidth Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - (2 Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 xpadding)) height :: Int32 height = case StrutSize heightSize of ExactSize h :: Int32 h -> Int32 h ScreenRatio p :: Rational p -> Rational -> Int32 forall a b. (RealFrac a, Integral b) => a -> b floor (Rational -> Int32) -> Rational -> Int32 forall a b. (a -> b) -> a -> b $ Rational p Rational -> Rational -> Rational forall a. Num a => a -> a -> a * Int32 -> Rational forall a b. (Integral a, Num b) => a -> b fromIntegral (Int32 monitorHeight Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - (2 Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 ypadding)) Geometry -> Int32 -> m () forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m () Gdk.setGeometryBaseWidth Geometry geometry Int32 width Geometry -> Int32 -> m () forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m () Gdk.setGeometryBaseHeight Geometry geometry Int32 height Geometry -> Int32 -> m () forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m () Gdk.setGeometryMinWidth Geometry geometry Int32 width Geometry -> Int32 -> m () forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m () Gdk.setGeometryMinHeight Geometry geometry Int32 height Geometry -> Int32 -> m () forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m () Gdk.setGeometryMaxWidth Geometry geometry Int32 width Geometry -> Int32 -> m () forall (m :: * -> *). MonadIO m => Geometry -> Int32 -> m () Gdk.setGeometryMaxHeight Geometry geometry Int32 height Window -> Maybe Window -> Maybe Geometry -> [WindowHints] -> m () forall (m :: * -> *) a b. (HasCallStack, MonadIO m, IsWindow a, IsWidget b) => a -> Maybe b -> Maybe Geometry -> [WindowHints] -> m () Gtk.windowSetGeometryHints Window window (Maybe Window forall a. Maybe a Nothing :: Maybe Gtk.Window) (Geometry -> Maybe Geometry forall a. a -> Maybe a Just Geometry geometry) [WindowHints] allHints let paddedHeight :: Int32 paddedHeight = Int32 height Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + 2 Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 ypadding paddedWidth :: Int32 paddedWidth = Int32 width Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + 2 Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 xpadding getAlignedPos :: a -> a -> a -> a -> a getAlignedPos dimensionPos :: a dimensionPos dpadding :: a dpadding monitorSize :: a monitorSize barSize :: a barSize = a dimensionPos a -> a -> a forall a. Num a => a -> a -> a + case StrutAlignment alignment of Beginning -> a dpadding Center -> (a monitorSize a -> a -> a forall a. Num a => a -> a -> a - a barSize) a -> a -> a forall a. Integral a => a -> a -> a `div` 2 End -> a monitorSize a -> a -> a forall a. Num a => a -> a -> a - a barSize a -> a -> a forall a. Num a => a -> a -> a - a dpadding xAligned :: Int32 xAligned = Int32 -> Int32 -> Int32 -> Int32 -> Int32 forall a. Integral a => a -> a -> a -> a -> a getAlignedPos Int32 monitorX Int32 xpadding Int32 monitorWidth Int32 width yAligned :: Int32 yAligned = Int32 -> Int32 -> Int32 -> Int32 -> Int32 forall a. Integral a => a -> a -> a -> a -> a getAlignedPos Int32 monitorY Int32 ypadding Int32 monitorHeight Int32 height (xPos :: Int32 xPos, yPos :: Int32 yPos) = case StrutPosition position of TopPos -> (Int32 xAligned, Int32 monitorY Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 ypadding) BottomPos -> (Int32 xAligned, Int32 monitorY Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 monitorHeight Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 height Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 ypadding) LeftPos -> (Int32 monitorX Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 xpadding, Int32 yAligned) RightPos -> (Int32 monitorX Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 monitorWidth Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 width Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 xpadding, Int32 yAligned) Window -> Screen -> m () forall (m :: * -> *) a b. (HasCallStack, MonadIO m, IsWindow a, IsScreen b) => a -> b -> m () Gtk.windowSetScreen Window window Screen screen Window -> Int32 -> Int32 -> m () forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsWindow a) => a -> Int32 -> Int32 -> m () Gtk.windowMove Window window Int32 xPos Int32 yPos Window -> Bool -> m () forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsWindow a) => a -> Bool -> m () Gtk.windowSetKeepBelow Window window Bool True let ewmhSettings :: EWMHStrutSettings ewmhSettings = case StrutPosition position of TopPos -> EWMHStrutSettings zeroStrutSettings { _top :: Int32 _top = Int32 monitorY Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 paddedHeight , _top_start_x :: Int32 _top_start_x = Int32 xPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 xpadding , _top_end_x :: Int32 _top_end_x = Int32 xPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 width Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 xpadding Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - 1 } BottomPos -> EWMHStrutSettings zeroStrutSettings { _bottom :: Int32 _bottom = Int32 screenHeight Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 monitorY Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 monitorHeight Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 paddedHeight , _bottom_start_x :: Int32 _bottom_start_x = Int32 xPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 xpadding , _bottom_end_x :: Int32 _bottom_end_x = Int32 xPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 width Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 xpadding Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - 1 } LeftPos -> EWMHStrutSettings zeroStrutSettings { _left :: Int32 _left = Int32 monitorX Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 paddedWidth , _left_start_y :: Int32 _left_start_y = Int32 yPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 ypadding , _left_end_y :: Int32 _left_end_y = Int32 yPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 height Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 ypadding Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - 1 } RightPos -> EWMHStrutSettings zeroStrutSettings { _right :: Int32 _right = Int32 screenWidth Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 monitorX Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 monitorWidth Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 paddedWidth , _right_start_y :: Int32 _right_start_y = Int32 yPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - Int32 ypadding , _right_end_y :: Int32 _right_end_y = Int32 yPos Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 height Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a + Int32 ypadding Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a - 1 } setStrutProperties :: IO () setStrutProperties = IO (Maybe ()) -> IO () forall (f :: * -> *) a. Functor f => f a -> f () void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO () forall a b. (a -> b) -> a -> b $ MaybeT IO () -> IO (Maybe ()) forall (m :: * -> *) a. MaybeT m a -> m (Maybe a) runMaybeT (MaybeT IO () -> IO (Maybe ())) -> MaybeT IO () -> IO (Maybe ()) forall a b. (a -> b) -> a -> b $ do Window gdkWindow <- IO (Maybe Window) -> MaybeT IO Window forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a MaybeT (IO (Maybe Window) -> MaybeT IO Window) -> IO (Maybe Window) -> MaybeT IO Window forall a b. (a -> b) -> a -> b $ Window -> IO (Maybe Window) forall (m :: * -> *) a. (HasCallStack, MonadIO m, IsWidget a) => a -> m (Maybe Window) Gtk.widgetGetWindow Window window IO () -> MaybeT IO () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO () forall a b. (a -> b) -> a -> b $ Window -> EWMHStrutSettings -> IO () forall (m :: * -> *) w. (MonadIO m, IsWindow w) => w -> EWMHStrutSettings -> m () setStrut Window gdkWindow EWMHStrutSettings ewmhSettings m SignalHandlerId -> m () forall (f :: * -> *) a. Functor f => f a -> f () void (m SignalHandlerId -> m ()) -> m SignalHandlerId -> m () forall a b. (a -> b) -> a -> b $ Window -> IO () -> m SignalHandlerId forall a (m :: * -> *). (IsWidget a, MonadIO m) => a -> IO () -> m SignalHandlerId Gtk.onWidgetRealize Window window IO () setStrutProperties allHints :: [Gdk.WindowHints] allHints :: [WindowHints] allHints = [ WindowHints Gdk.WindowHintsMinSize , WindowHints Gdk.WindowHintsMaxSize , WindowHints Gdk.WindowHintsBaseSize , WindowHints Gdk.WindowHintsUserPos , WindowHints Gdk.WindowHintsUserSize ]