    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE MonoLocalBinds #-}
    module Graphics.UI.EWMHStrut where

    import           Control.Monad.IO.Class
    import           Data.Int
    import           Data.Text
    import           Data.Word
    import           Foreign.C.Types
    import           Foreign.Marshal.Array
    import           Foreign.Ptr
    import           Foreign.Storable

    import qualified GI.Gdk as Gdk

    data EWMHStrutSettings = EWMHStrutSettings
      { EWMHStrutSettings -> Int32
    _left :: Int32
      , EWMHStrutSettings -> Int32
    _right :: Int32
      , EWMHStrutSettings -> Int32
    _top :: Int32
      , EWMHStrutSettings -> Int32
    _bottom :: Int32
      , EWMHStrutSettings -> Int32
    _left_start_y :: Int32
      , EWMHStrutSettings -> Int32
    _left_end_y :: Int32
      , EWMHStrutSettings -> Int32
    _right_start_y :: Int32
      , EWMHStrutSettings -> Int32
    _right_end_y :: Int32
      , EWMHStrutSettings -> Int32
    _top_start_x :: Int32
      , EWMHStrutSettings -> Int32
    _top_end_x :: Int32
      , EWMHStrutSettings -> Int32
    _bottom_start_x :: Int32
      , EWMHStrutSettings -> Int32
    _bottom_end_x :: Int32
      } deriving (Int -> EWMHStrutSettings -> ShowS
    [EWMHStrutSettings] -> ShowS
    EWMHStrutSettings -> String
    (Int -> EWMHStrutSettings -> ShowS)
    -> (EWMHStrutSettings -> String)
    -> ([EWMHStrutSettings] -> ShowS)
    -> Show EWMHStrutSettings
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> EWMHStrutSettings -> ShowS
    showsPrec :: Int -> EWMHStrutSettings -> ShowS
    $cshow :: EWMHStrutSettings -> String
    show :: EWMHStrutSettings -> String
    $cshowList :: [EWMHStrutSettings] -> ShowS
    showList :: [EWMHStrutSettings] -> ShowS
    Show, EWMHStrutSettings -> EWMHStrutSettings -> Bool
    (EWMHStrutSettings -> EWMHStrutSettings -> Bool)
    -> (EWMHStrutSettings -> EWMHStrutSettings -> Bool)
    -> Eq EWMHStrutSettings
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: EWMHStrutSettings -> EWMHStrutSettings -> Bool
    == :: EWMHStrutSettings -> EWMHStrutSettings -> Bool
    $c/= :: EWMHStrutSettings -> EWMHStrutSettings -> Bool
    /= :: EWMHStrutSettings -> EWMHStrutSettings -> Bool
    Eq)

    zeroStrutSettings :: EWMHStrutSettings
    zeroStrutSettings = EWMHStrutSettings
      { _left :: Int32
    _left = Int32
    0
      , _right :: Int32
    _right = Int32
    0
      , _top :: Int32
    _top = Int32
    0
      , _bottom :: Int32
    _bottom = Int32
    0
      , _left_start_y :: Int32
    _left_start_y = Int32
    0
      , _left_end_y :: Int32
    _left_end_y = Int32
    0
      , _right_start_y :: Int32
    _right_start_y = Int32
    0
      , _right_end_y :: Int32
    _right_end_y = Int32
    0
      , _top_start_x :: Int32
    _top_start_x = Int32
    0
      , _top_end_x :: Int32
    _top_end_x = Int32
    0
      , _bottom_start_x :: Int32
    _bottom_start_x = Int32
    0
      , _bottom_end_x :: Int32
    _bottom_end_x = Int32
    0
      }

    scaleStrutSettings :: Int32 -> EWMHStrutSettings -> EWMHStrutSettings
    scaleStrutSettings :: Int32 -> EWMHStrutSettings -> EWMHStrutSettings
    scaleStrutSettings Int32
    scaleFactor EWMHStrutSettings
    st = EWMHStrutSettings
    st
      { _left = _left st * scaleFactor
      , _right = _right st * scaleFactor
      , _top = _top st * scaleFactor
      , _bottom = _bottom st * scaleFactor
      , _left_start_y = _left_start_y st * scaleFactor
      , _left_end_y = _left_end_y st * scaleFactor
      , _right_start_y = _right_start_y st * scaleFactor
      , _right_end_y = _right_end_y st * scaleFactor
      , _top_start_x = _top_start_x st * scaleFactor
      , _top_end_x = _top_end_x st * scaleFactor
      , _bottom_start_x = _bottom_start_x st * scaleFactor
      , _bottom_end_x = _bottom_end_x st * scaleFactor
      }

    strutSettingsToPtr :: MonadIO m => EWMHStrutSettings -> m (Ptr CULong)
    strutSettingsToPtr :: forall (m :: * -> *).
    MonadIO m =>
    EWMHStrutSettings -> m (Ptr CULong)
    strutSettingsToPtr EWMHStrutSettings
                         { _left :: EWMHStrutSettings -> Int32
    _left = Int32
    left
                         , _right :: EWMHStrutSettings -> Int32
    _right = Int32
    right
                         , _top :: EWMHStrutSettings -> Int32
    _top = Int32
    top
                         , _bottom :: EWMHStrutSettings -> Int32
    _bottom = Int32
    bottom
                         , _left_start_y :: EWMHStrutSettings -> Int32
    _left_start_y = Int32
    left_start_y
                         , _left_end_y :: EWMHStrutSettings -> Int32
    _left_end_y = Int32
    left_end_y
                         , _right_start_y :: EWMHStrutSettings -> Int32
    _right_start_y = Int32
    right_start_y
                         , _right_end_y :: EWMHStrutSettings -> Int32
    _right_end_y = Int32
    right_end_y
                         , _top_start_x :: EWMHStrutSettings -> Int32
    _top_start_x = Int32
    top_start_x
                         , _top_end_x :: EWMHStrutSettings -> Int32
    _top_end_x = Int32
    top_end_x
                         , _bottom_start_x :: EWMHStrutSettings -> Int32
    _bottom_start_x = Int32
    bottom_start_x
                         , _bottom_end_x :: EWMHStrutSettings -> Int32
    _bottom_end_x = Int32
    bottom_end_x
                         } = IO (Ptr CULong) -> m (Ptr CULong)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Ptr CULong) -> m (Ptr CULong))
    -> IO (Ptr CULong) -> m (Ptr CULong)
    forall a b. (a -> b) -> a -> b
    $ do
      arr <- Int -> IO (Ptr CULong)
    forall a. Storable a => Int -> IO (Ptr a)
    mallocArray Int
    12
      let doPoke Int
    off Int32
    v = Ptr CULong -> Int -> CULong -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr CULong
    arr Int
    off (CULong -> IO ()) -> CULong -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int32 -> CULong
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    v
      doPoke 0 left
      doPoke 1 right
      doPoke 2 top
      doPoke 3 bottom
      doPoke 4 left_start_y
      doPoke 5 left_end_y
      doPoke 6 right_start_y
      doPoke 7 right_end_y
      doPoke 8 top_start_x
      doPoke 9 top_end_x
      doPoke 10 bottom_start_x
      doPoke 11 bottom_end_x
      return arr

    foreign import ccall "gdk_property_change" gdk_property_change ::
      Ptr Gdk.Window ->
        Ptr Gdk.Atom -> Ptr Gdk.Atom -> Int32 -> CUInt -> Ptr CUChar -> Int32 -> IO ()

    propertyChange
      :: (Gdk.IsWindow a, MonadIO m)
      => a
      -> Gdk.Atom
      -> Gdk.Atom
      -> Int32
      -> Gdk.PropMode
      -> Ptr CUChar
      -> Int32
      -> m ()
    propertyChange :: forall a (m :: * -> *).
    (IsWindow a, MonadIO m) =>
    a
    -> Atom -> Atom -> Int32 -> PropMode -> Ptr CUChar -> Int32 -> m ()
    propertyChange a
    window Atom
    property Atom
    type_ Int32
    format PropMode
    mode Ptr CUChar
    data_ Int32
    nelements = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        window' <- a -> IO (Ptr Window)
    forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
    Gdk.unsafeManagedPtrCastPtr a
    window
        property' <- Gdk.unsafeManagedPtrGetPtr property
        type_' <- Gdk.unsafeManagedPtrGetPtr type_
        let mode' = (Int -> CUInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CUInt) -> (PropMode -> Int) -> PropMode -> CUInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PropMode -> Int
    forall a. Enum a => a -> Int
    fromEnum) PropMode
    mode
        gdk_property_change window' property' type_' format mode' data_ nelements
        Gdk.touchManagedPtr window
        Gdk.touchManagedPtr property
        Gdk.touchManagedPtr type_
        return ()

    setStrut :: MonadIO m => Gdk.IsWindow w => w -> EWMHStrutSettings -> m ()
    setStrut :: forall (m :: * -> *) w.
    (MonadIO m, IsWindow w) =>
    w -> EWMHStrutSettings -> m ()
    setStrut w
    w EWMHStrutSettings
    settings = do
      strutAtom <- Text -> Bool -> m Atom
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Bool -> m Atom
    Gdk.atomIntern Text
    "_NET_WM_STRUT_PARTIAL" Bool
    False
      cardinalAtom <- Gdk.atomIntern "CARDINAL" False
      settingsArray <- castPtr <$> strutSettingsToPtr settings
      propertyChange w strutAtom cardinalAtom 32 Gdk.PropModeReplace settingsArray 12