{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.MouseResize
-- Description :  A layout modifier to resize windows with the mouse.
-- Copyright   :  (c) 2007 Andrea Rossato
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout modifier to resize windows with the mouse by grabbing the
-- window's lower right corner.
--
-- This module must be used together with "XMonad.Layout.WindowArranger".
-----------------------------------------------------------------------------

module XMonad.Actions.MouseResize
    ( -- * Usage:
      -- $usage
      mouseResize
    , MouseResize (..)
    ) where

import XMonad
import XMonad.Layout.Decoration

import XMonad.Layout.WindowArranger
import XMonad.Util.XUtils

-- $usage
-- Usually this module is used to create layouts, but you can also use
-- it to resize windows in any layout, together with the
-- "XMonad.Layout.WindowArranger". For usage example see
-- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".
--
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Actions.MouseResize
-- > import XMonad.Layout.WindowArranger
--
-- Then edit your @layoutHook@ by modifying a given layout:
--
-- > myLayout = mouseResize $ windowArrange $ layoutHook def
--
-- and then:
--
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".

mouseResize :: l a -> ModifiedLayout MouseResize l a
mouseResize :: forall (l :: * -> *) a. l a -> ModifiedLayout MouseResize l a
mouseResize = MouseResize a -> l a -> ModifiedLayout MouseResize l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout ([((a, Rectangle), Maybe a)] -> MouseResize a
forall a. [((a, Rectangle), Maybe a)] -> MouseResize a
MR [])

newtype MouseResize a = MR [((a,Rectangle),Maybe a)]
instance Show (MouseResize a) where show :: MouseResize a -> String
show        MouseResize a
_ = String
""
instance Read (MouseResize a) where readsPrec :: Int -> ReadS (MouseResize a)
readsPrec Int
_ String
s = [([((a, Rectangle), Maybe a)] -> MouseResize a
forall a. [((a, Rectangle), Maybe a)] -> MouseResize a
MR [], String
s)]

instance LayoutModifier MouseResize Window where
    redoLayout :: MouseResize EventMask
-> Rectangle
-> Maybe (Stack EventMask)
-> [(EventMask, Rectangle)]
-> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
redoLayout MouseResize EventMask
_       Rectangle
_ Maybe (Stack EventMask)
Nothing  [(EventMask, Rectangle)]
wrs = ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
-> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(EventMask, Rectangle)]
wrs, Maybe (MouseResize EventMask)
forall a. Maybe a
Nothing)
    redoLayout (MR [((EventMask, Rectangle), Maybe EventMask)]
st) Rectangle
_ (Just Stack EventMask
s) [(EventMask, Rectangle)]
wrs
        | [] <- [((EventMask, Rectangle), Maybe EventMask)]
st  = X [((EventMask, Rectangle), Maybe EventMask)]
initState    X [((EventMask, Rectangle), Maybe EventMask)]
-> ([((EventMask, Rectangle), Maybe EventMask)]
    -> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask)))
-> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[((EventMask, Rectangle), Maybe EventMask)]
nst -> ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
-> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(EventMask, Rectangle)]
wrs, MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a. a -> Maybe a
Just (MouseResize EventMask -> Maybe (MouseResize EventMask))
-> MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a b. (a -> b) -> a -> b
$ [((EventMask, Rectangle), Maybe EventMask)]
-> MouseResize EventMask
forall a. [((a, Rectangle), Maybe a)] -> MouseResize a
MR [((EventMask, Rectangle), Maybe EventMask)]
nst)
        | Bool
otherwise = X [((EventMask, Rectangle), Maybe EventMask)]
processState X [((EventMask, Rectangle), Maybe EventMask)]
-> ([((EventMask, Rectangle), Maybe EventMask)]
    -> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask)))
-> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[((EventMask, Rectangle), Maybe EventMask)]
nst -> ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
-> X ([(EventMask, Rectangle)], Maybe (MouseResize EventMask))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(EventMask, Rectangle)]
wrs, MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a. a -> Maybe a
Just (MouseResize EventMask -> Maybe (MouseResize EventMask))
-> MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a b. (a -> b) -> a -> b
$ [((EventMask, Rectangle), Maybe EventMask)]
-> MouseResize EventMask
forall a. [((a, Rectangle), Maybe a)] -> MouseResize a
MR [((EventMask, Rectangle), Maybe EventMask)]
nst)
        where
          wrs' :: [((EventMask, Rectangle), Maybe Rectangle)]
wrs'         = [Rectangle]
-> [(EventMask, Rectangle)]
-> [((EventMask, Rectangle), Maybe Rectangle)]
forall {a}.
[Rectangle]
-> [(a, Rectangle)] -> [((a, Rectangle), Maybe Rectangle)]
wrs_to_state [] ([(EventMask, Rectangle)]
 -> [((EventMask, Rectangle), Maybe Rectangle)])
-> ([(EventMask, Rectangle)] -> [(EventMask, Rectangle)])
-> [(EventMask, Rectangle)]
-> [((EventMask, Rectangle), Maybe Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EventMask, Rectangle) -> Bool)
-> [(EventMask, Rectangle)] -> [(EventMask, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Stack EventMask -> EventMask -> Bool
forall a. Eq a => Stack a -> a -> Bool
isInStack Stack EventMask
s (EventMask -> Bool)
-> ((EventMask, Rectangle) -> EventMask)
-> (EventMask, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventMask, Rectangle) -> EventMask
forall a b. (a, b) -> a
fst) ([(EventMask, Rectangle)]
 -> [((EventMask, Rectangle), Maybe Rectangle)])
-> [(EventMask, Rectangle)]
-> [((EventMask, Rectangle), Maybe Rectangle)]
forall a b. (a -> b) -> a -> b
$ [(EventMask, Rectangle)]
wrs
          initState :: X [((EventMask, Rectangle), Maybe EventMask)]
initState    = (((EventMask, Rectangle), Maybe Rectangle)
 -> X ((EventMask, Rectangle), Maybe EventMask))
-> [((EventMask, Rectangle), Maybe Rectangle)]
-> X [((EventMask, Rectangle), Maybe EventMask)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((EventMask, Rectangle), Maybe Rectangle)
-> X ((EventMask, Rectangle), Maybe EventMask)
createInputWindow [((EventMask, Rectangle), Maybe Rectangle)]
wrs'
          processState :: X [((EventMask, Rectangle), Maybe EventMask)]
processState = (((EventMask, Rectangle), Maybe EventMask) -> X ())
-> [((EventMask, Rectangle), Maybe EventMask)] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe EventMask -> X ()
deleteInputWin (Maybe EventMask -> X ())
-> (((EventMask, Rectangle), Maybe EventMask) -> Maybe EventMask)
-> ((EventMask, Rectangle), Maybe EventMask)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EventMask, Rectangle), Maybe EventMask) -> Maybe EventMask
forall a b. (a, b) -> b
snd) [((EventMask, Rectangle), Maybe EventMask)]
st X ()
-> X [((EventMask, Rectangle), Maybe EventMask)]
-> X [((EventMask, Rectangle), Maybe EventMask)]
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (((EventMask, Rectangle), Maybe Rectangle)
 -> X ((EventMask, Rectangle), Maybe EventMask))
-> [((EventMask, Rectangle), Maybe Rectangle)]
-> X [((EventMask, Rectangle), Maybe EventMask)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((EventMask, Rectangle), Maybe Rectangle)
-> X ((EventMask, Rectangle), Maybe EventMask)
createInputWindow [((EventMask, Rectangle), Maybe Rectangle)]
wrs'

          inputRectangle :: Rectangle -> Rectangle
inputRectangle (Rectangle Position
x Position
y EventType
wh EventType
ht) = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi EventType
wh Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
5) (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fi EventType
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
5) EventType
10 EventType
10

          wrs_to_state :: [Rectangle]
-> [(a, Rectangle)] -> [((a, Rectangle), Maybe Rectangle)]
wrs_to_state [Rectangle]
rs ((a
w,Rectangle
r):[(a, Rectangle)]
xs)
              | Rectangle
ir Rectangle -> [Rectangle] -> Bool
`isVisible` [Rectangle]
rs = ((a
w,Rectangle
r),Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just Rectangle
ir) ((a, Rectangle), Maybe Rectangle)
-> [((a, Rectangle), Maybe Rectangle)]
-> [((a, Rectangle), Maybe Rectangle)]
forall a. a -> [a] -> [a]
: [Rectangle]
-> [(a, Rectangle)] -> [((a, Rectangle), Maybe Rectangle)]
wrs_to_state (Rectangle
rRectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
:Rectangle
irRectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
:[Rectangle]
rs) [(a, Rectangle)]
xs
              | Bool
otherwise         = ((a
w,Rectangle
r),Maybe Rectangle
forall a. Maybe a
Nothing) ((a, Rectangle), Maybe Rectangle)
-> [((a, Rectangle), Maybe Rectangle)]
-> [((a, Rectangle), Maybe Rectangle)]
forall a. a -> [a] -> [a]
: [Rectangle]
-> [(a, Rectangle)] -> [((a, Rectangle), Maybe Rectangle)]
wrs_to_state (Rectangle
rRectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
:   [Rectangle]
rs) [(a, Rectangle)]
xs
              where ir :: Rectangle
ir = Rectangle -> Rectangle
inputRectangle Rectangle
r
          wrs_to_state [Rectangle]
_ [] = []

    handleMess :: MouseResize EventMask
-> SomeMessage -> X (Maybe (MouseResize EventMask))
handleMess (MR [((EventMask, Rectangle), Maybe EventMask)]
s) SomeMessage
m
        | Just Event
e <- SomeMessage -> Maybe Event
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m :: Maybe Event = [((EventMask, Rectangle), Maybe EventMask)] -> Event -> X ()
handleResize [((EventMask, Rectangle), Maybe EventMask)]
s Event
e X ()
-> X (Maybe (MouseResize EventMask))
-> X (Maybe (MouseResize EventMask))
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MouseResize EventMask) -> X (Maybe (MouseResize EventMask))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MouseResize EventMask)
forall a. Maybe a
Nothing
        | Just LayoutMessages
Hide             <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = X ()
releaseResources X ()
-> X (Maybe (MouseResize EventMask))
-> X (Maybe (MouseResize EventMask))
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MouseResize EventMask) -> X (Maybe (MouseResize EventMask))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a. a -> Maybe a
Just (MouseResize EventMask -> Maybe (MouseResize EventMask))
-> MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a b. (a -> b) -> a -> b
$ [((EventMask, Rectangle), Maybe EventMask)]
-> MouseResize EventMask
forall a. [((a, Rectangle), Maybe a)] -> MouseResize a
MR [])
        | Just LayoutMessages
ReleaseResources <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = X ()
releaseResources X ()
-> X (Maybe (MouseResize EventMask))
-> X (Maybe (MouseResize EventMask))
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MouseResize EventMask) -> X (Maybe (MouseResize EventMask))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a. a -> Maybe a
Just (MouseResize EventMask -> Maybe (MouseResize EventMask))
-> MouseResize EventMask -> Maybe (MouseResize EventMask)
forall a b. (a -> b) -> a -> b
$ [((EventMask, Rectangle), Maybe EventMask)]
-> MouseResize EventMask
forall a. [((a, Rectangle), Maybe a)] -> MouseResize a
MR [])
        where releaseResources :: X ()
releaseResources = (((EventMask, Rectangle), Maybe EventMask) -> X ())
-> [((EventMask, Rectangle), Maybe EventMask)] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe EventMask -> X ()
deleteInputWin (Maybe EventMask -> X ())
-> (((EventMask, Rectangle), Maybe EventMask) -> Maybe EventMask)
-> ((EventMask, Rectangle), Maybe EventMask)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EventMask, Rectangle), Maybe EventMask) -> Maybe EventMask
forall a b. (a, b) -> b
snd) [((EventMask, Rectangle), Maybe EventMask)]
s
    handleMess MouseResize EventMask
_ SomeMessage
_ = Maybe (MouseResize EventMask) -> X (Maybe (MouseResize EventMask))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MouseResize EventMask)
forall a. Maybe a
Nothing

handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X ()
handleResize :: [((EventMask, Rectangle), Maybe EventMask)] -> Event -> X ()
handleResize [((EventMask, Rectangle), Maybe EventMask)]
st ButtonEvent { ev_window :: Event -> EventMask
ev_window = EventMask
ew, ev_event_type :: Event -> EventType
ev_event_type = EventType
et }
    | EventType
et EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
buttonPress
    , Just (EventMask
w,Rectangle Position
wx Position
wy EventType
_ EventType
_) <- EventMask
-> [((EventMask, Rectangle), Maybe EventMask)]
-> Maybe (EventMask, Rectangle)
forall {t} {a} {b}.
Eq t =>
t -> [((a, b), Maybe t)] -> Maybe (a, b)
getWin EventMask
ew [((EventMask, Rectangle), Maybe EventMask)]
st = do
                                        EventMask -> X ()
focus EventMask
w
                                        (Position -> Position -> X ()) -> X () -> X ()
mouseDrag (\Position
x Position
y -> do
                                                     let rect :: Rectangle
rect = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle Position
wx Position
wy
                                                                (EventType -> EventType -> EventType
forall a. Ord a => a -> a -> a
max EventType
1 (EventType -> EventType)
-> (Position -> EventType) -> Position -> EventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (Position -> EventType) -> Position -> EventType
forall a b. (a -> b) -> a -> b
$ Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
wx)
                                                                (EventType -> EventType -> EventType
forall a. Ord a => a -> a -> a
max EventType
1 (EventType -> EventType)
-> (Position -> EventType) -> Position -> EventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> EventType
forall a b. (Integral a, Num b) => a -> b
fi (Position -> EventType) -> Position -> EventType
forall a b. (a -> b) -> a -> b
$ Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
wy)
                                                     WindowArrangerMsg -> X ()
forall a. Message a => a -> X ()
sendMessage (Rectangle -> WindowArrangerMsg
SetGeometry Rectangle
rect)) (() -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

      where
        getWin :: t -> [((a, b), Maybe t)] -> Maybe (a, b)
getWin t
w (((a
win,b
r),Maybe t
tw):[((a, b), Maybe t)]
xs)
            | Just t
w' <- Maybe t
tw
            , t
w t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
w'   = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
win,b
r)
            | Bool
otherwise = t -> [((a, b), Maybe t)] -> Maybe (a, b)
getWin t
w [((a, b), Maybe t)]
xs
        getWin t
_ []     = Maybe (a, b)
forall a. Maybe a
Nothing
handleResize [((EventMask, Rectangle), Maybe EventMask)]
_ Event
_ = () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
createInputWindow :: ((EventMask, Rectangle), Maybe Rectangle)
-> X ((EventMask, Rectangle), Maybe EventMask)
createInputWindow ((EventMask
w,Rectangle
r),Maybe Rectangle
mr) =
  case Maybe Rectangle
mr of
    Just Rectangle
tr  -> (Display -> X ((EventMask, Rectangle), Maybe EventMask))
-> X ((EventMask, Rectangle), Maybe EventMask)
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ((EventMask, Rectangle), Maybe EventMask))
 -> X ((EventMask, Rectangle), Maybe EventMask))
-> (Display -> X ((EventMask, Rectangle), Maybe EventMask))
-> X ((EventMask, Rectangle), Maybe EventMask)
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
                  EventMask
tw <- Display -> Rectangle -> X EventMask
mkInputWindow Display
d Rectangle
tr
                  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> EventMask -> IO ()
selectInput Display
d EventMask
tw (EventMask
exposureMask EventMask -> EventMask -> EventMask
forall a. Bits a => a -> a -> a
.|. EventMask
buttonPressMask)

                  EventMask
cursor <- IO EventMask -> X EventMask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO EventMask -> X EventMask) -> IO EventMask -> X EventMask
forall a b. (a -> b) -> a -> b
$ Display -> Glyph -> IO EventMask
createFontCursor Display
d Glyph
xC_bottom_right_corner
                  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> EventMask -> IO ()
defineCursor Display
d EventMask
tw EventMask
cursor
                  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
freeCursor Display
d EventMask
cursor

                  EventMask -> X ()
showWindow EventMask
tw
                  ((EventMask, Rectangle), Maybe EventMask)
-> X ((EventMask, Rectangle), Maybe EventMask)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ((EventMask
w,Rectangle
r), EventMask -> Maybe EventMask
forall a. a -> Maybe a
Just EventMask
tw)
    Maybe Rectangle
Nothing ->    ((EventMask, Rectangle), Maybe EventMask)
-> X ((EventMask, Rectangle), Maybe EventMask)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ((EventMask
w,Rectangle
r), Maybe EventMask
forall a. Maybe a
Nothing)

deleteInputWin :: Maybe Window -> X ()
deleteInputWin :: Maybe EventMask -> X ()
deleteInputWin = X () -> (EventMask -> X ()) -> Maybe EventMask -> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) EventMask -> X ()
deleteWindow

mkInputWindow :: Display -> Rectangle -> X Window
mkInputWindow :: Display -> Rectangle -> X EventMask
mkInputWindow Display
d (Rectangle Position
x Position
y EventType
w EventType
h) = do
  EventMask
rw <- (XConf -> EventMask) -> X EventMask
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> EventMask
theRoot
  let screen :: Screen
screen   = Display -> Screen
defaultScreenOfDisplay Display
d
      visual :: Visual
visual   = Screen -> Visual
defaultVisualOfScreen Screen
screen
      attrmask :: EventMask
attrmask = EventMask
cWOverrideRedirect
  IO EventMask -> X EventMask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO EventMask -> X EventMask) -> IO EventMask -> X EventMask
forall a b. (a -> b) -> a -> b
$ (Ptr SetWindowAttributes -> IO EventMask) -> IO EventMask
forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO EventMask) -> IO EventMask)
-> (Ptr SetWindowAttributes -> IO EventMask) -> IO EventMask
forall a b. (a -> b) -> a -> b
$
         \Ptr SetWindowAttributes
attributes -> do
           Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
True
           Display
-> EventMask
-> Position
-> Position
-> EventType
-> EventType
-> CInt
-> CInt
-> CInt
-> Visual
-> EventMask
-> Ptr SetWindowAttributes
-> IO EventMask
createWindow Display
d EventMask
rw Position
x Position
y EventType
w EventType
h CInt
0 CInt
0 CInt
inputOnly Visual
visual EventMask
attrmask Ptr SetWindowAttributes
attributes