{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.MouseResizableTile
-- 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 qualified XMonad.StackSet as W
import XMonad.Util.XUtils
import Control.Applicative((<$>))

-- $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
                    deriving Typeable
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 -> Dimension
gapWidth :: Dimension -- ^ width of a gap between windows
                    , DraggerType -> Dimension
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 { MouseResizableTile a -> Int
nmaster :: Int,
                                    -- ^ Get/set the number of windows in
                                    -- master pane (default: 1).
                                    MouseResizableTile a -> Rational
masterFrac :: Rational,
                                    -- ^ Get/set the proportion of screen
                                    -- occupied by master pane (default: 1/2).
                                    MouseResizableTile a -> Rational
slaveFrac :: Rational,
                                    -- ^ Get/set the proportion of remaining
                                    -- space in a column occupied by a slave
                                    -- window (default: 1/2).
                                    MouseResizableTile a -> Rational
fracIncrement :: Rational,
                                    -- ^ Get/set the increment used when
                                    -- modifying masterFrac/slaveFrac by the
                                    -- Shrink, Expand, etc. messages (default:
                                    -- 3/100).
                                    MouseResizableTile a -> [Rational]
leftFracs :: [Rational],
                                    MouseResizableTile a -> [Rational]
rightFracs :: [Rational],
                                    MouseResizableTile a -> [DraggerWithWin]
draggers :: [DraggerWithWin],
                                    MouseResizableTile a -> DraggerType
draggerType :: DraggerType,
                                    -- ^ Get/set dragger and gap dimensions
                                    -- (default: FixedDragger 6 6).
                                    MouseResizableTile a -> Int
focusPos :: Int,
                                    MouseResizableTile a -> Int
numWindows :: Int,
                                    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 :: 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 1 0.5 0.5 0.03 [] [] [] (Dimension -> Dimension -> DraggerType
FixedDragger 6 6) 0 0 Bool
False

-- | May be removed in favor of @mouseResizableTile { isMirrored = True }@
mouseResizableTileMirrored :: MouseResizableTile a
mouseResizableTileMirrored :: 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 st :: MouseResizableTile Window
st sr :: Rectangle
sr (W.Stack w :: Window
w l :: [Window]
l r :: [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)
            (rects :: [Rectangle]
rects, preparedDraggers :: [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
        (draggerWrs :: [(Window, Rectangle)]
draggerWrs, newDraggers :: [DraggerWithWin]
newDraggers) <- [((Window, Rectangle), DraggerWithWin)]
-> ([(Window, Rectangle)], [DraggerWithWin])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Window, Rectangle), DraggerWithWin)]
 -> ([(Window, Rectangle)], [DraggerWithWin]))
-> X [((Window, Rectangle), DraggerWithWin)]
-> X ([(Window, Rectangle)], [DraggerWithWin])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin))
-> [DraggerWithRect] -> X [((Window, Rectangle), DraggerWithWin)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                        (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 a :: p
a b :: 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 st :: MouseResizableTile Window
st m :: SomeMessage
m
        | Just (IncMasterN d :: 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 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 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 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 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 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 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 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 f :: 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 0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min 1 Rational
f) }
        | Just (SetLeftSlaveFraction pos :: Int
pos f :: 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 0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min 1 Rational
f)) }
        | Just (SetRightSlaveFraction pos :: Int
pos f :: 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 0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min 1 Rational
f)) }

        | Just e :: 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 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 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 _ _ = 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 st :: MouseResizableTile Window
st = ShowS
mirror "MouseResizableTile"
        where mirror :: ShowS
mirror = if MouseResizableTile Window -> Bool
forall a. MouseResizableTile a -> Bool
isMirrored MouseResizableTile Window
st then ("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 g :: Dimension
g d :: Dimension
d) =
    DraggerGeometry -> X DraggerGeometry
forall (m :: * -> *) a. Monad m => a -> m a
return (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension -> Position) -> Dimension -> Position
forall a b. (a -> b) -> a -> b
$ Dimension
g Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` 2, Dimension
g, Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension -> Position) -> Dimension -> Position
forall a b. (a -> b) -> a -> b
$ Dimension
d Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` 2, Dimension
d)
draggerGeometry BordersDragger = do
    Dimension
w <- (XConf -> Dimension) -> X Dimension
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> Dimension
forall (l :: * -> *). XConfig l -> Dimension
borderWidth (XConfig Layout -> Dimension)
-> (XConf -> XConfig Layout) -> XConf -> Dimension
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 (0, 0, Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w, 2Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
*Dimension
w)

adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect
adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect
adjustForMirror False dragger :: DraggerWithRect
dragger = DraggerWithRect
dragger
adjustForMirror True (draggerRect :: Rectangle
draggerRect, draggerCursor :: Glyph
draggerCursor, draggerInfo :: 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 :: MouseResizableTile a -> Rational -> MouseResizableTile a
modifySlave st :: MouseResizableTile a
st delta :: 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
- 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
- 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
> 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
- 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 0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min 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
> 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
- 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 0 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min 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 :: Rational -> [Rational] -> t -> Rational -> [Rational]
replaceAtPos _ [] 0 x' :: Rational
x' = [Rational
x']
replaceAtPos d :: Rational
d [] pos :: t
pos x' :: 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
- 1) Rational
x'
replaceAtPos _ (_:xs :: [Rational]
xs) 0 x' :: Rational
x' = Rational
x' Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: [Rational]
xs
replaceAtPos d :: Rational
d (x :: Rational
x:xs :: [Rational]
xs) pos :: t
pos x' :: 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
-1 ) Rational
x'

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

within :: (Ord a) => a -> a -> a -> a
within :: a -> a -> a -> a
within low :: a
low high :: a
high a :: 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 nmaster' :: Int
nmaster' masterFrac' :: Rational
masterFrac' leftFracs' :: [Rational]
leftFracs' rightFracs' :: [Rational]
rightFracs' sr :: Rectangle
sr num :: Int
num drg :: 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
- 1) [Rational]
leftFracs') Rectangle
sr Bool
True 0 DraggerGeometry
drg
    | Int
nmaster' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
- 1) [Rational]
rightFracs') Rectangle
sr Bool
False 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 ((sr1 :: Rectangle
sr1, sr2 :: Rectangle
sr2), masterDragger :: 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
          (leftRects :: [Rectangle]
leftRects, leftDraggers :: [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
- 1) [Rational]
leftFracs') Rectangle
sr1 Bool
True 0 DraggerGeometry
drg
          (rightRects :: [Rectangle]
rightRects, rightDraggers :: [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
- 1) [Rational]
rightFracs') Rectangle
sr2 Bool
False 0 DraggerGeometry
drg

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

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

createDragger :: Rectangle -> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin)
createDragger :: Rectangle
-> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin)
createDragger sr :: Rectangle
sr (draggerRect :: Rectangle
draggerRect, draggerCursor :: Glyph
draggerCursor, draggerInfo :: 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 (draggerWin :: Window
draggerWin, _) = Window -> X ()
deleteWindow Window
draggerWin

handleResize :: [DraggerWithWin] -> Bool -> Event -> X ()
handleResize :: [DraggerWithWin] -> Bool -> Event -> X ()
handleResize draggers' :: [DraggerWithWin]
draggers' isM :: Bool
isM ButtonEvent { ev_window :: Event -> Window
ev_window = Window
ew, ev_event_type :: Event -> Dimension
ev_event_type = Dimension
et }
    | Dimension
et Dimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
== Dimension
buttonPress, Just x :: 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     lb :: Position
lb r :: Rational
r     -> ((Position -> Position -> Position)
 -> Position -> Position -> Position)
-> Position -> Rational -> (Rational -> MRTMessage) -> X ()
forall a t a p.
(Message a, Fractional t, Integral a) =>
((p -> p -> p) -> Position -> Position -> a)
-> a -> t -> (t -> a) -> X ()
mouseDrag' (Position -> Position -> Position)
-> Position -> Position -> Position
forall a. a -> a
id   Position
lb Rational
r  Rational -> MRTMessage
SetMasterFraction
        LeftSlaveDragger  lb :: Position
lb r :: Rational
r num :: Int
num -> ((Position -> Position -> Position)
 -> Position -> Position -> Position)
-> Position -> Rational -> (Rational -> MRTMessage) -> X ()
forall a t a p.
(Message a, Fractional t, Integral a) =>
((p -> p -> p) -> Position -> Position -> a)
-> a -> t -> (t -> 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 lb :: Position
lb r :: Rational
r num :: Int
num -> ((Position -> Position -> Position)
 -> Position -> Position -> Position)
-> Position -> Rational -> (Rational -> MRTMessage) -> X ()
forall a t a p.
(Message a, Fractional t, Integral a) =>
((p -> p -> p) -> Position -> Position -> a)
-> a -> t -> (t -> 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 isM' :: Bool
isM' axis1 :: p
axis1 axis2 :: p
axis2 = if Bool
isM' then p
axis2 else p
axis1
        mouseDrag' :: ((p -> p -> p) -> Position -> Position -> a)
-> a -> t -> (t -> a) -> X ()
mouseDrag' flp :: (p -> p -> p) -> Position -> Position -> a
flp lowerBound :: a
lowerBound range :: t
range msg :: t -> 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
$ \x :: Position
x y :: Position
y -> do
                let axis :: a
axis = (p -> p -> p) -> Position -> Position -> a
flp (Bool -> p -> p -> p
forall p. Bool -> p -> p -> p
chooseAxis Bool
isM) Position
x Position
y
                    fraction :: t
fraction = a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
axis a -> a -> a
forall a. Num a => a -> a -> a
- a
lowerBound) t -> t -> t
forall a. Fractional a => a -> a -> a
/ t
range
                a -> X ()
forall a. Message a => a -> X ()
sendMessage (t -> a
msg t
fraction)

handleResize _ _ _ = () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

createInputWindow :: Glyph -> Rectangle -> X Window
createInputWindow :: Glyph -> Rectangle -> X Window
createInputWindow cursorGlyph :: Glyph
cursorGlyph r :: 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
$ \d :: 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 d :: Display
d (Rectangle x :: Position
x y :: Position
y w :: Dimension
w h :: Dimension
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
$
         \attributes :: Ptr SetWindowAttributes
attributes -> do
           Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
True
           Display
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> CInt
-> CInt
-> CInt
-> Visual
-> Window
-> Ptr SetWindowAttributes
-> IO Window
createWindow Display
d Window
rw Position
x Position
y Dimension
w Dimension
h 0 0 CInt
inputOnly Visual
visual Window
attrmask Ptr SetWindowAttributes
attributes