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 Rational
1
  , strutHeight :: StrutSize
strutHeight = Rational -> StrutSize
ScreenRatio Rational
1
  , strutXPadding :: Int32
strutXPadding = Int32
0
  , strutYPadding :: Int32
strutYPadding = Int32
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 :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
StrutConfig -> m Window
buildStrutWindow 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 :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
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 = do
  Just 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 <- 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) [Int32
0..(Int32
monitorCountInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
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 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 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 Int32
w -> Int32
w
                ScreenRatio 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
- (Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
xpadding))
      height :: Int32
height = case StrutSize
heightSize of
                 ExactSize Int32
h -> Int32
h
                 ScreenRatio 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
- (Int32
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
+ Int32
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
+ Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
xpadding
      getAlignedPos :: a -> a -> a -> a -> a
getAlignedPos a
dimensionPos a
dpadding a
monitorSize a
barSize =
        a
dimensionPos a -> a -> a
forall a. Num a => a -> a -> a
+
        case StrutAlignment
alignment of
          StrutAlignment
Beginning -> a
dpadding
          StrutAlignment
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` a
2
          StrutAlignment
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
      (Int32
xPos, Int32
yPos) =
        case StrutPosition
position of
          StrutPosition
TopPos -> (Int32
xAligned, Int32
monitorY Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
ypadding)
          StrutPosition
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)
          StrutPosition
LeftPos -> (Int32
monitorX Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
xpadding, Int32
yAligned)
          StrutPosition
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
          StrutPosition
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
- Int32
1
            }
          StrutPosition
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
- Int32
1
            }
          StrutPosition
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
- Int32
1
            }
          StrutPosition
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
- Int32
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 -> ((?self::Window) => IO ()) -> m SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
Gtk.onWidgetRealize Window
window IO ()
(?self::Window) => IO ()
setStrutProperties

allHints :: [Gdk.WindowHints]
allHints :: [WindowHints]
allHints =
  [ WindowHints
Gdk.WindowHintsMinSize
  , WindowHints
Gdk.WindowHintsMaxSize
  , WindowHints
Gdk.WindowHintsBaseSize
  , WindowHints
Gdk.WindowHintsUserPos
  , WindowHints
Gdk.WindowHintsUserSize
  ]