{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.MouseResizableTile
-- Description :  Like "XMonad.Layout.ResizableTile", but use the mouse to adjust the layout.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option
-- to use the mouse to adjust the layout.
--
-----------------------------------------------------------------------------

module XMonad.Layout.MouseResizableTile (
                                    -- * Usage
                                    -- $usage
                                    mouseResizableTile,
                                    mouseResizableTileMirrored,
                                    MRTMessage (ShrinkSlave, ExpandSlave),

                                    -- * Parameters
                                    -- $mrtParameters
                                    nmaster,
                                    masterFrac,
                                    slaveFrac,
                                    fracIncrement,
                                    isMirrored,
                                    draggerType,
                                    DraggerType (..),
                                    MouseResizableTile,
                                   ) where

import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Util.XUtils
import Graphics.X11 as X

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.MouseResizableTile
--
-- Then edit your @layoutHook@ by adding the MouseResizableTile layout.
-- Either in its normal form or the mirrored version. (The mirror layout modifier
-- will not work correctly here because of the use of the mouse.)
--
-- > myLayout = mouseResizableTile ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- You may also want to add the following key bindings:
--
-- > , ((modm,               xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area
-- > , ((modm,               xK_i), sendMessage ExpandSlave) -- %! Expand a slave area
--
-- For detailed instruction on editing the key binding see:
--
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- $mrtParameters
-- The following functions are also labels for updating the @data@ (whose
-- representation is otherwise hidden) produced by 'mouseResizableTile'.
--
-- Usage:
--
-- > myLayout = mouseResizableTile{ masterFrac = 0.7,
-- >                                fracIncrement = 0.05,
-- >                                draggerType = BordersDragger }
-- >                |||  etc..

data MRTMessage = SetMasterFraction Rational
                    | SetLeftSlaveFraction Int Rational
                    | SetRightSlaveFraction Int Rational
                    | ShrinkSlave
                    | ExpandSlave
instance Message MRTMessage

data DraggerInfo = MasterDragger Position Rational
                    | LeftSlaveDragger Position Rational Int
                    | RightSlaveDragger Position Rational Int
                    deriving (Int -> DraggerInfo -> ShowS
[DraggerInfo] -> ShowS
DraggerInfo -> String
(Int -> DraggerInfo -> ShowS)
-> (DraggerInfo -> String)
-> ([DraggerInfo] -> ShowS)
-> Show DraggerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DraggerInfo] -> ShowS
$cshowList :: [DraggerInfo] -> ShowS
show :: DraggerInfo -> String
$cshow :: DraggerInfo -> String
showsPrec :: Int -> DraggerInfo -> ShowS
$cshowsPrec :: Int -> DraggerInfo -> ShowS
Show, ReadPrec [DraggerInfo]
ReadPrec DraggerInfo
Int -> ReadS DraggerInfo
ReadS [DraggerInfo]
(Int -> ReadS DraggerInfo)
-> ReadS [DraggerInfo]
-> ReadPrec DraggerInfo
-> ReadPrec [DraggerInfo]
-> Read DraggerInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DraggerInfo]
$creadListPrec :: ReadPrec [DraggerInfo]
readPrec :: ReadPrec DraggerInfo
$creadPrec :: ReadPrec DraggerInfo
readList :: ReadS [DraggerInfo]
$creadList :: ReadS [DraggerInfo]
readsPrec :: Int -> ReadS DraggerInfo
$creadsPrec :: Int -> ReadS DraggerInfo
Read)
type DraggerWithRect = (Rectangle, Glyph, DraggerInfo)
type DraggerWithWin = (Window, DraggerInfo)

-- | Specifies the size of the clickable area between windows.
data DraggerType = FixedDragger
                    { DraggerType -> EventType
gapWidth :: Dimension -- ^ width of a gap between windows
                    , DraggerType -> EventType
draggerWidth :: Dimension -- ^ width of the dragger itself
                                                -- (will overlap windows if greater than gap)
                    }
                    | BordersDragger -- ^ no gaps, draggers overlap window borders
                    deriving (Int -> DraggerType -> ShowS
[DraggerType] -> ShowS
DraggerType -> String
(Int -> DraggerType -> ShowS)
-> (DraggerType -> String)
-> ([DraggerType] -> ShowS)
-> Show DraggerType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DraggerType] -> ShowS
$cshowList :: [DraggerType] -> ShowS
show :: DraggerType -> String
$cshow :: DraggerType -> String
showsPrec :: Int -> DraggerType -> ShowS
$cshowsPrec :: Int -> DraggerType -> ShowS
Show, ReadPrec [DraggerType]
ReadPrec DraggerType
Int -> ReadS DraggerType
ReadS [DraggerType]
(Int -> ReadS DraggerType)
-> ReadS [DraggerType]
-> ReadPrec DraggerType
-> ReadPrec [DraggerType]
-> Read DraggerType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DraggerType]
$creadListPrec :: ReadPrec [DraggerType]
readPrec :: ReadPrec DraggerType
$creadPrec :: ReadPrec DraggerType
readList :: ReadS [DraggerType]
$creadList :: ReadS [DraggerType]
readsPrec :: Int -> ReadS DraggerType
$creadsPrec :: Int -> ReadS DraggerType
Read)
type DraggerGeometry = (Position, Dimension, Position, Dimension)

data MouseResizableTile a = MRT { forall a. MouseResizableTile a -> Int
nmaster :: Int,
                                    -- ^ Get/set the number of windows in
                                    -- master pane (default: 1).
                                    forall a. MouseResizableTile a -> Rational
masterFrac :: Rational,
                                    -- ^ Get/set the proportion of screen
                                    -- occupied by master pane (default: 1/2).
                                    forall a. MouseResizableTile a -> Rational
slaveFrac :: Rational,
                                    -- ^ Get/set the proportion of remaining
                                    -- space in a column occupied by a slave
                                    -- window (default: 1/2).
                                    forall a. MouseResizableTile a -> Rational
fracIncrement :: Rational,
                                    -- ^ Get/set the increment used when
                                    -- modifying masterFrac/slaveFrac by the
                                    -- Shrink, Expand, etc. messages (default:
                                    -- 3/100).
                                    forall a. MouseResizableTile a -> [Rational]
leftFracs :: [Rational],
                                    forall a. MouseResizableTile a -> [Rational]
rightFracs :: [Rational],
                                    forall a. MouseResizableTile a -> [DraggerWithWin]
draggers :: [DraggerWithWin],
                                    forall a. MouseResizableTile a -> DraggerType
draggerType :: DraggerType,
                                    -- ^ Get/set dragger and gap dimensions
                                    -- (default: FixedDragger 6 6).
                                    forall a. MouseResizableTile a -> Int
focusPos :: Int,
                                    forall a. MouseResizableTile a -> Int
numWindows :: Int,
                                    forall a. MouseResizableTile a -> Bool
isMirrored :: Bool
                                    -- ^ Get/set whether the layout is
                                    -- mirrored (default: False).
                                } deriving (Int -> MouseResizableTile a -> ShowS
[MouseResizableTile a] -> ShowS
MouseResizableTile a -> String
(Int -> MouseResizableTile a -> ShowS)
-> (MouseResizableTile a -> String)
-> ([MouseResizableTile a] -> ShowS)
-> Show (MouseResizableTile a)
forall a. Int -> MouseResizableTile a -> ShowS
forall a. [MouseResizableTile a] -> ShowS
forall a. MouseResizableTile a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseResizableTile a] -> ShowS
$cshowList :: forall a. [MouseResizableTile a] -> ShowS
show :: MouseResizableTile a -> String
$cshow :: forall a. MouseResizableTile a -> String
showsPrec :: Int -> MouseResizableTile a -> ShowS
$cshowsPrec :: forall a. Int -> MouseResizableTile a -> ShowS
Show, ReadPrec [MouseResizableTile a]
ReadPrec (MouseResizableTile a)
Int -> ReadS (MouseResizableTile a)
ReadS [MouseResizableTile a]
(Int -> ReadS (MouseResizableTile a))
-> ReadS [MouseResizableTile a]
-> ReadPrec (MouseResizableTile a)
-> ReadPrec [MouseResizableTile a]
-> Read (MouseResizableTile a)
forall a. ReadPrec [MouseResizableTile a]
forall a. ReadPrec (MouseResizableTile a)
forall a. Int -> ReadS (MouseResizableTile a)
forall a. ReadS [MouseResizableTile a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MouseResizableTile a]
$creadListPrec :: forall a. ReadPrec [MouseResizableTile a]
readPrec :: ReadPrec (MouseResizableTile a)
$creadPrec :: forall a. ReadPrec (MouseResizableTile a)
readList :: ReadS [MouseResizableTile a]
$creadList :: forall a. ReadS [MouseResizableTile a]
readsPrec :: Int -> ReadS (MouseResizableTile a)
$creadsPrec :: forall a. Int -> ReadS (MouseResizableTile a)
Read)

mouseResizableTile :: MouseResizableTile a
mouseResizableTile :: forall a. MouseResizableTile a
mouseResizableTile = Int
-> Rational
-> Rational
-> Rational
-> [Rational]
-> [Rational]
-> [DraggerWithWin]
-> DraggerType
-> Int
-> Int
-> Bool
-> MouseResizableTile a
forall a.
Int
-> Rational
-> Rational
-> Rational
-> [Rational]
-> [Rational]
-> [DraggerWithWin]
-> DraggerType
-> Int
-> Int
-> Bool
-> MouseResizableTile a
MRT Int
1 Rational
0.5 Rational
0.5 Rational
0.03 [] [] [] (EventType -> EventType -> DraggerType
FixedDragger EventType
6 EventType
6) Int
0 Int
0 Bool
False

-- | May be removed in favor of @mouseResizableTile { isMirrored = True }@
mouseResizableTileMirrored :: MouseResizableTile a
mouseResizableTileMirrored :: forall a. MouseResizableTile a
mouseResizableTileMirrored = MouseResizableTile Any
forall a. MouseResizableTile a
mouseResizableTile { isMirrored :: Bool
isMirrored = Bool
True }

instance LayoutClass MouseResizableTile Window where
    doLayout :: MouseResizableTile Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (MouseResizableTile Window))
doLayout MouseResizableTile Window
st Rectangle
sr (W.Stack Window
w [Window]
l [Window]
r) = do
        DraggerGeometry
drg <- DraggerType -> X DraggerGeometry
draggerGeometry (DraggerType -> X DraggerGeometry)
-> DraggerType -> X DraggerGeometry
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> DraggerType
forall a. MouseResizableTile a -> DraggerType
draggerType MouseResizableTile Window
st
        let wins :: [Window]
wins = [Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
l [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ Window
w Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
: [Window]
r
            num :: Int
num = [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
wins
            sr' :: Rectangle
sr' = Rectangle -> Rectangle -> Rectangle
forall {p}. p -> p -> p
mirrorAdjust Rectangle
sr (Rectangle -> Rectangle
mirrorRect Rectangle
sr)
            ([Rectangle]
rects, [DraggerWithRect]
preparedDraggers) = Int
-> Rational
-> [Rational]
-> [Rational]
-> Rectangle
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
tile (MouseResizableTile Window -> Int
forall a. MouseResizableTile a -> Int
nmaster MouseResizableTile Window
st) (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
masterFrac MouseResizableTile Window
st)
                                            (MouseResizableTile Window -> [Rational]
forall a. MouseResizableTile a -> [Rational]
leftFracs MouseResizableTile Window
st [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
slaveFrac MouseResizableTile Window
st))
                                            (MouseResizableTile Window -> [Rational]
forall a. MouseResizableTile a -> [Rational]
rightFracs MouseResizableTile Window
st [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
slaveFrac MouseResizableTile Window
st)) Rectangle
sr' Int
num DraggerGeometry
drg
            rects' :: [Rectangle]
rects' = (Rectangle -> Rectangle) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map ((Rectangle -> Rectangle)
-> (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall {p}. p -> p -> p
mirrorAdjust Rectangle -> Rectangle
forall a. a -> a
id Rectangle -> Rectangle
mirrorRect (Rectangle -> Rectangle)
-> (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle -> Rectangle
sanitizeRectangle Rectangle
sr') [Rectangle]
rects
        (DraggerWithWin -> X ()) -> [DraggerWithWin] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DraggerWithWin -> X ()
deleteDragger ([DraggerWithWin] -> X ()) -> [DraggerWithWin] -> X ()
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> [DraggerWithWin]
forall a. MouseResizableTile a -> [DraggerWithWin]
draggers MouseResizableTile Window
st
        ([(Window, Rectangle)]
draggerWrs, [DraggerWithWin]
newDraggers) <- (DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin))
-> [DraggerWithRect] -> X ([(Window, Rectangle)], [DraggerWithWin])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM
                                        (Rectangle
-> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin)
createDragger Rectangle
sr (DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin))
-> (DraggerWithRect -> DraggerWithRect)
-> DraggerWithRect
-> X ((Window, Rectangle), DraggerWithWin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DraggerWithRect -> DraggerWithRect
adjustForMirror (MouseResizableTile Window -> Bool
forall a. MouseResizableTile a -> Bool
isMirrored MouseResizableTile Window
st))
                                        [DraggerWithRect]
preparedDraggers
        ([(Window, Rectangle)], Maybe (MouseResizableTile Window))
-> X ([(Window, Rectangle)], Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
draggerWrs [(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [Window] -> [Rectangle] -> [(Window, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
wins [Rectangle]
rects', MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { draggers :: [DraggerWithWin]
draggers = [DraggerWithWin]
newDraggers,
                                                              focusPos :: Int
focusPos = [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
l,
                                                              numWindows :: Int
numWindows = [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
wins })
        where
            mirrorAdjust :: p -> p -> p
mirrorAdjust p
a p
b = if MouseResizableTile Window -> Bool
forall a. MouseResizableTile a -> Bool
isMirrored MouseResizableTile Window
st
                                then p
b
                                else p
a

    handleMessage :: MouseResizableTile Window
-> SomeMessage -> X (Maybe (MouseResizableTile Window))
handleMessage MouseResizableTile Window
st SomeMessage
m
        | Just (IncMasterN Int
d) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { nmaster :: Int
nmaster = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (MouseResizableTile Window -> Int
forall a. MouseResizableTile a -> Int
nmaster MouseResizableTile Window
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) }
        | Just Resize
Shrink <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { masterFrac :: Rational
masterFrac = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
masterFrac MouseResizableTile Window
st Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
fracIncrement MouseResizableTile Window
st) }
        | Just Resize
Expand <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { masterFrac :: Rational
masterFrac = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
masterFrac MouseResizableTile Window
st Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
fracIncrement MouseResizableTile Window
st) }
        | Just MRTMessage
ShrinkSlave <- SomeMessage -> Maybe MRTMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Rational -> MouseResizableTile Window
forall a. MouseResizableTile a -> Rational -> MouseResizableTile a
modifySlave MouseResizableTile Window
st (- MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
fracIncrement MouseResizableTile Window
st)
        | Just MRTMessage
ExpandSlave <- SomeMessage -> Maybe MRTMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Rational -> MouseResizableTile Window
forall a. MouseResizableTile a -> Rational -> MouseResizableTile a
modifySlave MouseResizableTile Window
st (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
fracIncrement MouseResizableTile Window
st)
        | Just (SetMasterFraction Rational
f) <- SomeMessage -> Maybe MRTMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { masterFrac :: Rational
masterFrac = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 Rational
f) }
        | Just (SetLeftSlaveFraction Int
pos Rational
f) <- SomeMessage -> Maybe MRTMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { leftFracs :: [Rational]
leftFracs = Rational -> [Rational] -> Int -> Rational -> [Rational]
forall t.
(Num t, Eq t) =>
Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
slaveFrac MouseResizableTile Window
st)
                (MouseResizableTile Window -> [Rational]
forall a. MouseResizableTile a -> [Rational]
leftFracs MouseResizableTile Window
st) Int
pos (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 Rational
f)) }
        | Just (SetRightSlaveFraction Int
pos Rational
f) <- SomeMessage -> Maybe MRTMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
            Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MouseResizableTile Window)
 -> X (Maybe (MouseResizableTile Window)))
-> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { rightFracs :: [Rational]
rightFracs = Rational -> [Rational] -> Int -> Rational -> [Rational]
forall t.
(Num t, Eq t) =>
Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos (MouseResizableTile Window -> Rational
forall a. MouseResizableTile a -> Rational
slaveFrac MouseResizableTile Window
st)
                (MouseResizableTile Window -> [Rational]
forall a. MouseResizableTile a -> [Rational]
rightFracs MouseResizableTile Window
st) Int
pos (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 Rational
f)) }

        | Just Event
e <- SomeMessage -> Maybe Event
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m :: Maybe Event = [DraggerWithWin] -> Bool -> Event -> X ()
handleResize (MouseResizableTile Window -> [DraggerWithWin]
forall a. MouseResizableTile a -> [DraggerWithWin]
draggers MouseResizableTile Window
st) (MouseResizableTile Window -> Bool
forall a. MouseResizableTile a -> Bool
isMirrored MouseResizableTile Window
st) Event
e X ()
-> X (Maybe (MouseResizableTile Window))
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MouseResizableTile Window)
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 (MouseResizableTile Window))
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { draggers :: [DraggerWithWin]
draggers = [] })
        | Just LayoutMessages
ReleaseResources <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = X ()
releaseResources X ()
-> X (Maybe (MouseResizableTile Window))
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a. a -> Maybe a
Just (MouseResizableTile Window -> Maybe (MouseResizableTile Window))
-> MouseResizableTile Window -> Maybe (MouseResizableTile Window)
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window
st { draggers :: [DraggerWithWin]
draggers = [] })
        where releaseResources :: X ()
releaseResources = (DraggerWithWin -> X ()) -> [DraggerWithWin] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DraggerWithWin -> X ()
deleteDragger ([DraggerWithWin] -> X ()) -> [DraggerWithWin] -> X ()
forall a b. (a -> b) -> a -> b
$ MouseResizableTile Window -> [DraggerWithWin]
forall a. MouseResizableTile a -> [DraggerWithWin]
draggers MouseResizableTile Window
st
    handleMessage MouseResizableTile Window
_ SomeMessage
_ = Maybe (MouseResizableTile Window)
-> X (Maybe (MouseResizableTile Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MouseResizableTile Window)
forall a. Maybe a
Nothing

    description :: MouseResizableTile Window -> String
description MouseResizableTile Window
st = ShowS
mirror String
"MouseResizableTile"
        where mirror :: ShowS
mirror = if MouseResizableTile Window -> Bool
forall a. MouseResizableTile a -> Bool
isMirrored MouseResizableTile Window
st then (String
"Mirror " String -> ShowS
forall a. [a] -> [a] -> [a]
++) else ShowS
forall a. a -> a
id

draggerGeometry :: DraggerType -> X DraggerGeometry
draggerGeometry :: DraggerType -> X DraggerGeometry
draggerGeometry (FixedDragger EventType
g EventType
d) =
    DraggerGeometry -> X DraggerGeometry
forall (m :: * -> *) a. Monad m => a -> m a
return (EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EventType -> Position) -> EventType -> Position
forall a b. (a -> b) -> a -> b
$ EventType
g EventType -> EventType -> EventType
forall a. Integral a => a -> a -> a
`div` EventType
2, EventType
g, EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EventType -> Position) -> EventType -> Position
forall a b. (a -> b) -> a -> b
$ EventType
d EventType -> EventType -> EventType
forall a. Integral a => a -> a -> a
`div` EventType
2, EventType
d)
draggerGeometry DraggerType
BordersDragger = do
    WindowSet
wins <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    EventType
w <- case WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
wins of
          Just Window
win -> Window -> X EventType
getBorderWidth Window
win
          Maybe Window
_        -> (XConf -> EventType) -> X EventType
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> EventType
forall (l :: * -> *). XConfig l -> EventType
borderWidth (XConfig Layout -> EventType)
-> (XConf -> XConfig Layout) -> XConf -> EventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    DraggerGeometry -> X DraggerGeometry
forall (m :: * -> *) a. Monad m => a -> m a
return (Position
0, EventType
0, EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
w, EventType
2EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
*EventType
w)

getBorderWidth :: Window -> X Dimension
getBorderWidth :: Window -> X EventType
getBorderWidth Window
win = do
    Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    (Window
_,Position
_,Position
_,EventType
_,EventType
_,EventType
w,CInt
_) <- IO
  (Window, Position, Position, EventType, EventType, EventType, CInt)
-> X (Window, Position, Position, EventType, EventType, EventType,
      CInt)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO
   (Window, Position, Position, EventType, EventType, EventType, CInt)
 -> X (Window, Position, Position, EventType, EventType, EventType,
       CInt))
-> IO
     (Window, Position, Position, EventType, EventType, EventType, CInt)
-> X (Window, Position, Position, EventType, EventType, EventType,
      CInt)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO
     (Window, Position, Position, EventType, EventType, EventType, CInt)
X.getGeometry Display
d Window
win
    EventType -> X EventType
forall (m :: * -> *) a. Monad m => a -> m a
return EventType
w

adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect
adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect
adjustForMirror Bool
False DraggerWithRect
dragger = DraggerWithRect
dragger
adjustForMirror Bool
True (Rectangle
draggerRect, Glyph
draggerCursor, DraggerInfo
draggerInfo) =
        (Rectangle -> Rectangle
mirrorRect Rectangle
draggerRect, Glyph
draggerCursor', DraggerInfo
draggerInfo)
    where
        draggerCursor' :: Glyph
draggerCursor' = if Glyph
draggerCursor Glyph -> Glyph -> Bool
forall a. Eq a => a -> a -> Bool
== Glyph
xC_sb_h_double_arrow
                            then Glyph
xC_sb_v_double_arrow
                            else Glyph
xC_sb_h_double_arrow

modifySlave :: MouseResizableTile a -> Rational -> MouseResizableTile a
modifySlave :: forall a. MouseResizableTile a -> Rational -> MouseResizableTile a
modifySlave MouseResizableTile a
st Rational
delta =
    let pos :: Int
pos = MouseResizableTile a -> Int
forall a. MouseResizableTile a -> Int
focusPos MouseResizableTile a
st
        num :: Int
num = MouseResizableTile a -> Int
forall a. MouseResizableTile a -> Int
numWindows MouseResizableTile a
st
        nmaster' :: Int
nmaster' = MouseResizableTile a -> Int
forall a. MouseResizableTile a -> Int
nmaster MouseResizableTile a
st
        leftFracs' :: [Rational]
leftFracs' = MouseResizableTile a -> [Rational]
forall a. MouseResizableTile a -> [Rational]
leftFracs MouseResizableTile a
st
        rightFracs' :: [Rational]
rightFracs' = MouseResizableTile a -> [Rational]
forall a. MouseResizableTile a -> [Rational]
rightFracs MouseResizableTile a
st
        slFrac :: Rational
slFrac = MouseResizableTile a -> Rational
forall a. MouseResizableTile a -> Rational
slaveFrac MouseResizableTile a
st
        draggersLeft :: Int
draggersLeft = Int
nmaster' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        draggersRight :: Int
draggersRight = (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nmaster') Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    in if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nmaster'
        then if Int
draggersLeft Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then let draggerPos :: Int
draggerPos = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
draggersLeft Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
pos
                         oldFraction :: Rational
oldFraction = ([Rational]
leftFracs' [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat Rational
slFrac) [Rational] -> Int -> Rational
forall a. [a] -> Int -> a
!! Int
draggerPos
                     in MouseResizableTile a
st { leftFracs :: [Rational]
leftFracs = Rational -> [Rational] -> Int -> Rational -> [Rational]
forall t.
(Num t, Eq t) =>
Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos Rational
slFrac [Rational]
leftFracs' Int
draggerPos
                                            (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational
oldFraction Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
delta))) }
                else MouseResizableTile a
st
        else if Int
draggersRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then let draggerPos :: Int
draggerPos = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
draggersRight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nmaster')
                         oldFraction :: Rational
oldFraction = ([Rational]
rightFracs' [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat Rational
slFrac) [Rational] -> Int -> Rational
forall a. [a] -> Int -> a
!! Int
draggerPos
                     in MouseResizableTile a
st { rightFracs :: [Rational]
rightFracs = Rational -> [Rational] -> Int -> Rational -> [Rational]
forall t.
(Num t, Eq t) =>
Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos Rational
slFrac [Rational]
rightFracs' Int
draggerPos
                                            (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational
oldFraction Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
delta))) }
                else MouseResizableTile a
st

replaceAtPos :: (Num t, Eq t) => Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos :: forall t.
(Num t, Eq t) =>
Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos Rational
_ [] t
0 Rational
x' = [Rational
x']
replaceAtPos Rational
d [] t
pos Rational
x' = Rational
d Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: Rational -> [Rational] -> t -> Rational -> [Rational]
forall t.
(Num t, Eq t) =>
Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos Rational
d [] (t
pos t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Rational
x'
replaceAtPos Rational
_ (Rational
_:[Rational]
xs) t
0 Rational
x' = Rational
x' Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: [Rational]
xs
replaceAtPos Rational
d (Rational
x:[Rational]
xs) t
pos Rational
x' = Rational
x Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: Rational -> [Rational] -> t -> Rational -> [Rational]
forall t.
(Num t, Eq t) =>
Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos Rational
d [Rational]
xs (t
pos t -> t -> t
forall a. Num a => a -> a -> a
-t
1 ) Rational
x'

sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle
sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle
sanitizeRectangle (Rectangle Position
sx Position
sy EventType
swh EventType
sht) (Rectangle Position
x Position
y EventType
wh EventType
ht) =
    Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (Position -> Position -> Position -> Position
forall a. Ord a => a -> a -> a -> a
within Position
0 (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
swh) Position
x) (Position -> Position -> Position -> Position
forall a. Ord a => a -> a -> a -> a
within Position
0 (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
sht) Position
y)
                (EventType -> EventType -> EventType -> EventType
forall a. Ord a => a -> a -> a -> a
within EventType
1 EventType
swh EventType
wh) (EventType -> EventType -> EventType -> EventType
forall a. Ord a => a -> a -> a -> a
within EventType
1 EventType
sht EventType
ht)

within :: (Ord a) => a -> a -> a -> a
within :: forall a. Ord a => a -> a -> a -> a
within a
low a
high a
a = a -> a -> a
forall a. Ord a => a -> a -> a
max a
low (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
min a
high a
a

tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect])
tile :: Int
-> Rational
-> [Rational]
-> [Rational]
-> Rectangle
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
tile Int
nmaster' Rational
masterFrac' [Rational]
leftFracs' [Rational]
rightFracs' Rectangle
sr Int
num DraggerGeometry
drg
    | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nmaster'       = [Rational]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
forall r.
RealFrac r =>
[r]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
splitVertically (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Rational]
leftFracs') Rectangle
sr Bool
True Int
0 DraggerGeometry
drg
    | Int
nmaster' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0         = [Rational]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
forall r.
RealFrac r =>
[r]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
splitVertically (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Rational]
rightFracs') Rectangle
sr Bool
False Int
0 DraggerGeometry
drg
    | Bool
otherwise             = ([Rectangle]
leftRects [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ [Rectangle]
rightRects, DraggerWithRect
masterDragger DraggerWithRect -> [DraggerWithRect] -> [DraggerWithRect]
forall a. a -> [a] -> [a]
: [DraggerWithRect]
leftDraggers [DraggerWithRect] -> [DraggerWithRect] -> [DraggerWithRect]
forall a. [a] -> [a] -> [a]
++ [DraggerWithRect]
rightDraggers)
    where ((Rectangle
sr1, Rectangle
sr2), DraggerWithRect
masterDragger) = Rational
-> Rectangle
-> DraggerGeometry
-> ((Rectangle, Rectangle), DraggerWithRect)
forall r.
RealFrac r =>
r
-> Rectangle
-> DraggerGeometry
-> ((Rectangle, Rectangle), DraggerWithRect)
splitHorizontallyBy Rational
masterFrac' Rectangle
sr DraggerGeometry
drg
          ([Rectangle]
leftRects, [DraggerWithRect]
leftDraggers) = [Rational]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
forall r.
RealFrac r =>
[r]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
splitVertically (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take (Int
nmaster' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Rational]
leftFracs') Rectangle
sr1 Bool
True Int
0 DraggerGeometry
drg
          ([Rectangle]
rightRects, [DraggerWithRect]
rightDraggers) = [Rational]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
forall r.
RealFrac r =>
[r]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
splitVertically (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nmaster' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Rational]
rightFracs') Rectangle
sr2 Bool
False Int
0 DraggerGeometry
drg

splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect])
splitVertically :: forall r.
RealFrac r =>
[r]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
splitVertically [] Rectangle
r Bool
_ Int
_ DraggerGeometry
_ = ([Rectangle
r], [])
splitVertically (r
f:[r]
fx) (Rectangle Position
sx Position
sy EventType
sw EventType
sh) Bool
isLeft Int
num drg :: DraggerGeometry
drg@(Position
drOff, EventType
drSz, Position
drOff2, EventType
drSz2) =
    let nextRect :: Rectangle
nextRect = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle Position
sx Position
sy EventType
sw (EventType -> Rectangle) -> EventType -> Rectangle
forall a b. (a -> b) -> a -> b
$ EventType
smallh EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType -> EventType -> EventType
forall a. Integral a => a -> a -> a
div EventType
drSz EventType
2
        ([Rectangle]
otherRects, [DraggerWithRect]
otherDragger) = [r]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
forall r.
RealFrac r =>
[r]
-> Rectangle
-> Bool
-> Int
-> DraggerGeometry
-> ([Rectangle], [DraggerWithRect])
splitVertically [r]
fx
                                        (Position -> Position -> EventType -> EventType -> Rectangle
Rectangle Position
sx (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
smallh Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
drOff)
                                                    EventType
sw (EventType
sh EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType
smallh EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType -> EventType -> EventType
forall a. Integral a => a -> a -> a
div EventType
drSz EventType
2))
                                        Bool
isLeft (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) DraggerGeometry
drg
        draggerRect :: Rectangle
draggerRect = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle Position
sx (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
smallh Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
drOff2) EventType
sw EventType
drSz2
        draggerInfo :: DraggerInfo
draggerInfo = if Bool
isLeft
                        then Position -> Rational -> Int -> DraggerInfo
LeftSlaveDragger Position
sy (EventType -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
sh) Int
num
                        else Position -> Rational -> Int -> DraggerInfo
RightSlaveDragger Position
sy (EventType -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
sh) Int
num
        nextDragger :: DraggerWithRect
nextDragger = (Rectangle
draggerRect, Glyph
xC_sb_v_double_arrow, DraggerInfo
draggerInfo)
    in (Rectangle
nextRect Rectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
: [Rectangle]
otherRects, DraggerWithRect
nextDragger DraggerWithRect -> [DraggerWithRect] -> [DraggerWithRect]
forall a. a -> [a] -> [a]
: [DraggerWithRect]
otherDragger)
  where smallh :: EventType
smallh = r -> EventType
forall a b. (RealFrac a, Integral b) => a -> b
floor (r -> EventType) -> r -> EventType
forall a b. (a -> b) -> a -> b
$ EventType -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
sh r -> r -> r
forall a. Num a => a -> a -> a
* r
f

splitHorizontallyBy :: RealFrac r => r -> Rectangle -> DraggerGeometry -> ((Rectangle, Rectangle), DraggerWithRect)
splitHorizontallyBy :: forall r.
RealFrac r =>
r
-> Rectangle
-> DraggerGeometry
-> ((Rectangle, Rectangle), DraggerWithRect)
splitHorizontallyBy r
f (Rectangle Position
sx Position
sy EventType
sw EventType
sh) (Position
drOff, EventType
drSz, Position
drOff2, EventType
drSz2) =
    ((Rectangle
leftHalf, Rectangle
rightHalf), (Rectangle
draggerRect, Glyph
xC_sb_h_double_arrow, DraggerInfo
draggerInfo))
  where leftw :: EventType
leftw = r -> EventType
forall a b. (RealFrac a, Integral b) => a -> b
floor (r -> EventType) -> r -> EventType
forall a b. (a -> b) -> a -> b
$ EventType -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
sw r -> r -> r
forall a. Num a => a -> a -> a
* r
f
        leftHalf :: Rectangle
leftHalf = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle Position
sx Position
sy (EventType
leftw EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType
drSz EventType -> EventType -> EventType
forall a. Integral a => a -> a -> a
`div` EventType
2) EventType
sh
        rightHalf :: Rectangle
rightHalf = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
leftw Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
drOff) Position
sy
                                (EventType
sw EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType -> EventType
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
leftw EventType -> EventType -> EventType
forall a. Num a => a -> a -> a
- EventType
drSz EventType -> EventType -> EventType
forall a. Integral a => a -> a -> a
`div` EventType
2) EventType
sh
        draggerRect :: Rectangle
draggerRect = Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ EventType -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
leftw Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
drOff2) Position
sy EventType
drSz2 EventType
sh
        draggerInfo :: DraggerInfo
draggerInfo = Position -> Rational -> DraggerInfo
MasterDragger Position
sx (EventType -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
sw)

createDragger :: Rectangle -> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin)
createDragger :: Rectangle
-> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin)
createDragger Rectangle
sr (Rectangle
draggerRect, Glyph
draggerCursor, DraggerInfo
draggerInfo) = do
        let draggerRect' :: Rectangle
draggerRect' = Rectangle -> Rectangle -> Rectangle
sanitizeRectangle Rectangle
sr Rectangle
draggerRect
        Window
draggerWin <- Glyph -> Rectangle -> X Window
createInputWindow Glyph
draggerCursor Rectangle
draggerRect'
        ((Window, Rectangle), DraggerWithWin)
-> X ((Window, Rectangle), DraggerWithWin)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Window
draggerWin, Rectangle
draggerRect'), (Window
draggerWin, DraggerInfo
draggerInfo))

deleteDragger :: DraggerWithWin -> X ()
deleteDragger :: DraggerWithWin -> X ()
deleteDragger (Window
draggerWin, DraggerInfo
_) = Window -> X ()
deleteWindow Window
draggerWin

handleResize :: [DraggerWithWin] -> Bool -> Event -> X ()
handleResize :: [DraggerWithWin] -> Bool -> Event -> X ()
handleResize [DraggerWithWin]
draggers' Bool
isM ButtonEvent { ev_window :: Event -> Window
ev_window = Window
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 DraggerInfo
x <- Window -> [DraggerWithWin] -> Maybe DraggerInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Window
ew [DraggerWithWin]
draggers' = case DraggerInfo
x of
        MasterDragger     Position
lb Rational
r     -> ((Position -> Position -> Position)
 -> Position -> Position -> Position)
-> Position -> Rational -> (Rational -> MRTMessage) -> X ()
forall {a} {p} {p} {p}.
(Message a, Fractional p, Integral p) =>
((p -> p -> p) -> Position -> Position -> p)
-> p -> p -> (p -> a) -> X ()
mouseDrag' (Position -> Position -> Position)
-> Position -> Position -> Position
forall a. a -> a
id   Position
lb Rational
r  Rational -> MRTMessage
SetMasterFraction
        LeftSlaveDragger  Position
lb Rational
r Int
num -> ((Position -> Position -> Position)
 -> Position -> Position -> Position)
-> Position -> Rational -> (Rational -> MRTMessage) -> X ()
forall {a} {p} {p} {p}.
(Message a, Fractional p, Integral p) =>
((p -> p -> p) -> Position -> Position -> p)
-> p -> p -> (p -> a) -> X ()
mouseDrag' (Position -> Position -> Position)
-> Position -> Position -> Position
forall a b c. (a -> b -> c) -> b -> a -> c
flip Position
lb Rational
r (Int -> Rational -> MRTMessage
SetLeftSlaveFraction Int
num)
        RightSlaveDragger Position
lb Rational
r Int
num -> ((Position -> Position -> Position)
 -> Position -> Position -> Position)
-> Position -> Rational -> (Rational -> MRTMessage) -> X ()
forall {a} {p} {p} {p}.
(Message a, Fractional p, Integral p) =>
((p -> p -> p) -> Position -> Position -> p)
-> p -> p -> (p -> a) -> X ()
mouseDrag' (Position -> Position -> Position)
-> Position -> Position -> Position
forall a b c. (a -> b -> c) -> b -> a -> c
flip Position
lb Rational
r (Int -> Rational -> MRTMessage
SetRightSlaveFraction Int
num)
    where
        chooseAxis :: Bool -> p -> p -> p
chooseAxis Bool
isM' p
axis1 p
axis2 = if Bool
isM' then p
axis2 else p
axis1
        mouseDrag' :: ((p -> p -> p) -> Position -> Position -> p)
-> p -> p -> (p -> a) -> X ()
mouseDrag' (p -> p -> p) -> Position -> Position -> p
flp p
lowerBound p
range p -> a
msg = ((Position -> Position -> X ()) -> X () -> X ())
-> X () -> (Position -> Position -> X ()) -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Position -> Position -> X ()) -> X () -> X ()
mouseDrag (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((Position -> Position -> X ()) -> X ())
-> (Position -> Position -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Position
x Position
y -> do
                let axis :: p
axis = (p -> p -> p) -> Position -> Position -> p
flp (Bool -> p -> p -> p
forall {p}. Bool -> p -> p -> p
chooseAxis Bool
isM) Position
x Position
y
                    fraction :: p
fraction = p -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
axis p -> p -> p
forall a. Num a => a -> a -> a
- p
lowerBound) p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
range
                a -> X ()
forall a. Message a => a -> X ()
sendMessage (p -> a
msg p
fraction)

handleResize [DraggerWithWin]
_ Bool
_ Event
_ = () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

createInputWindow :: Glyph -> Rectangle -> X Window
createInputWindow :: Glyph -> Rectangle -> X Window
createInputWindow Glyph
cursorGlyph Rectangle
r = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
    Window
win <- Display -> Rectangle -> X Window
mkInputWindow Display
d Rectangle
r
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
d Window
win (Window
exposureMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
buttonPressMask)
    Window
cursor <- IO Window -> X Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Window -> X Window) -> IO Window -> X Window
forall a b. (a -> b) -> a -> b
$ Display -> Glyph -> IO Window
createFontCursor Display
d Glyph
cursorGlyph
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
defineCursor Display
d Window
win Window
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 -> Window -> IO ()
freeCursor Display
d Window
cursor
    Window -> X ()
showWindow Window
win
    Window -> X Window
forall (m :: * -> *) a. Monad m => a -> m a
return Window
win

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