{-# 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 showList :: [EWMHStrutSettings] -> ShowS $cshowList :: [EWMHStrutSettings] -> ShowS show :: EWMHStrutSettings -> String $cshow :: EWMHStrutSettings -> String showsPrec :: Int -> EWMHStrutSettings -> ShowS $cshowsPrec :: Int -> EWMHStrutSettings -> ShowS Show, EWMHStrutSettings -> EWMHStrutSettings -> Bool (EWMHStrutSettings -> EWMHStrutSettings -> Bool) -> (EWMHStrutSettings -> EWMHStrutSettings -> Bool) -> Eq EWMHStrutSettings forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: EWMHStrutSettings -> EWMHStrutSettings -> Bool $c/= :: EWMHStrutSettings -> EWMHStrutSettings -> Bool == :: EWMHStrutSettings -> EWMHStrutSettings -> Bool $c== :: EWMHStrutSettings -> EWMHStrutSettings -> Bool Eq) zeroStrutSettings :: EWMHStrutSettings zeroStrutSettings = EWMHStrutSettings :: Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> EWMHStrutSettings 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 :: Int32 _left = EWMHStrutSettings -> Int32 _left EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _right :: Int32 _right = EWMHStrutSettings -> Int32 _right EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _top :: Int32 _top = EWMHStrutSettings -> Int32 _top EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _bottom :: Int32 _bottom = EWMHStrutSettings -> Int32 _bottom EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _left_start_y :: Int32 _left_start_y = EWMHStrutSettings -> Int32 _left_start_y EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _left_end_y :: Int32 _left_end_y = EWMHStrutSettings -> Int32 _left_end_y EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _right_start_y :: Int32 _right_start_y = EWMHStrutSettings -> Int32 _right_start_y EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _right_end_y :: Int32 _right_end_y = EWMHStrutSettings -> Int32 _right_end_y EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _top_start_x :: Int32 _top_start_x = EWMHStrutSettings -> Int32 _top_start_x EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _top_end_x :: Int32 _top_end_x = EWMHStrutSettings -> Int32 _top_end_x EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _bottom_start_x :: Int32 _bottom_start_x = EWMHStrutSettings -> Int32 _bottom_start_x EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 scaleFactor , _bottom_end_x :: Int32 _bottom_end_x = EWMHStrutSettings -> Int32 _bottom_end_x EWMHStrutSettings st Int32 -> Int32 -> Int32 forall a. Num a => a -> a -> a * Int32 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 (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 Ptr CULong arr <- Int -> IO (Ptr CULong) forall a. Storable a => Int -> IO (Ptr a) mallocArray Int 12 let doPoke :: Int -> Int32 -> IO () 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 Int -> Int32 -> IO () doPoke Int 0 Int32 left Int -> Int32 -> IO () doPoke Int 1 Int32 right Int -> Int32 -> IO () doPoke Int 2 Int32 top Int -> Int32 -> IO () doPoke Int 3 Int32 bottom Int -> Int32 -> IO () doPoke Int 4 Int32 left_start_y Int -> Int32 -> IO () doPoke Int 5 Int32 left_end_y Int -> Int32 -> IO () doPoke Int 6 Int32 right_start_y Int -> Int32 -> IO () doPoke Int 7 Int32 right_end_y Int -> Int32 -> IO () doPoke Int 8 Int32 top_start_x Int -> Int32 -> IO () doPoke Int 9 Int32 top_end_x Int -> Int32 -> IO () doPoke Int 10 Int32 bottom_start_x Int -> Int32 -> IO () doPoke Int 11 Int32 bottom_end_x Ptr CULong -> IO (Ptr CULong) forall (m :: * -> *) a. Monad m => a -> m a return Ptr CULong 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 (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ do Ptr Window window' <- a -> IO (Ptr Window) forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b) Gdk.unsafeManagedPtrCastPtr a window Ptr Atom property' <- Atom -> IO (Ptr Atom) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) Gdk.unsafeManagedPtrGetPtr Atom property Ptr Atom type_' <- Atom -> IO (Ptr Atom) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) Gdk.unsafeManagedPtrGetPtr Atom type_ let mode' :: CUInt 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 Ptr Window -> Ptr Atom -> Ptr Atom -> Int32 -> CUInt -> Ptr CUChar -> Int32 -> IO () gdk_property_change Ptr Window window' Ptr Atom property' Ptr Atom type_' Int32 format CUInt mode' Ptr CUChar data_ Int32 nelements a -> IO () forall a. ManagedPtrNewtype a => a -> IO () Gdk.touchManagedPtr a window Atom -> IO () forall a. ManagedPtrNewtype a => a -> IO () Gdk.touchManagedPtr Atom property Atom -> IO () forall a. ManagedPtrNewtype a => a -> IO () Gdk.touchManagedPtr Atom type_ () -> IO () forall (m :: * -> *) a. Monad m => a -> m a 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 Atom strutAtom <- Text -> Bool -> m Atom forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> Bool -> m Atom Gdk.atomIntern Text "_NET_WM_STRUT_PARTIAL" Bool False Atom cardinalAtom <- Text -> Bool -> m Atom forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> Bool -> m Atom Gdk.atomIntern Text "CARDINAL" Bool False Ptr CUChar settingsArray <- Ptr CULong -> Ptr CUChar forall a b. Ptr a -> Ptr b castPtr (Ptr CULong -> Ptr CUChar) -> m (Ptr CULong) -> m (Ptr CUChar) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> EWMHStrutSettings -> m (Ptr CULong) forall (m :: * -> *). MonadIO m => EWMHStrutSettings -> m (Ptr CULong) strutSettingsToPtr EWMHStrutSettings settings w -> Atom -> Atom -> Int32 -> PropMode -> Ptr CUChar -> Int32 -> m () forall a (m :: * -> *). (IsWindow a, MonadIO m) => a -> Atom -> Atom -> Int32 -> PropMode -> Ptr CUChar -> Int32 -> m () propertyChange w w Atom strutAtom Atom cardinalAtom Int32 32 PropMode Gdk.PropModeReplace Ptr CUChar settingsArray Int32 12