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

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.DragPane
-- Description :  Split the screen either horizontally or vertically and show two windows.
-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
--                    David Roundy <droundy@darcs.net>,
--                    Andrea Rossato <andrea.rossato@unibz.it>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Layouts that splits the screen either horizontally or vertically and
-- shows two windows.  The first window is always the master window, and
-- the other is either the currently focused window or the second window in
-- layout order.

-----------------------------------------------------------------------------

module XMonad.Layout.DragPane (
                               -- * Usage
                               -- $usage
                                dragPane
                              , DragPane, DragType (..)
                              ) where

import XMonad
import Data.Unique

import qualified XMonad.StackSet as W
import XMonad.Util.Invisible
import XMonad.Util.XUtils

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.DragPane
--
-- Then edit your @layoutHook@ by adding the DragPane layout:
--
-- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".

halfHandleWidth :: Integral a => a
halfHandleWidth :: forall a. Integral a => a
halfHandleWidth = a
1

handleColor :: String
handleColor :: String
handleColor = String
"#000000"

dragPane :: DragType -> Double -> Double -> DragPane a
dragPane :: forall a. DragType -> Double -> Double -> DragPane a
dragPane = forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing)

data DragPane a =
    DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double
             deriving ( Int -> DragPane a -> ShowS
forall a. Int -> DragPane a -> ShowS
forall a. [DragPane a] -> ShowS
forall a. DragPane a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DragPane a] -> ShowS
$cshowList :: forall a. [DragPane a] -> ShowS
show :: DragPane a -> String
$cshow :: forall a. DragPane a -> String
showsPrec :: Int -> DragPane a -> ShowS
$cshowsPrec :: forall a. Int -> DragPane a -> ShowS
Show, ReadPrec [DragPane a]
ReadPrec (DragPane a)
ReadS [DragPane a]
forall a. ReadPrec [DragPane a]
forall a. ReadPrec (DragPane a)
forall a. Int -> ReadS (DragPane a)
forall a. ReadS [DragPane a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DragPane a]
$creadListPrec :: forall a. ReadPrec [DragPane a]
readPrec :: ReadPrec (DragPane a)
$creadPrec :: forall a. ReadPrec (DragPane a)
readList :: ReadS [DragPane a]
$creadList :: forall a. ReadS [DragPane a]
readsPrec :: Int -> ReadS (DragPane a)
$creadsPrec :: forall a. Int -> ReadS (DragPane a)
Read )

data DragType = Horizontal | Vertical deriving ( Int -> DragType -> ShowS
[DragType] -> ShowS
DragType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DragType] -> ShowS
$cshowList :: [DragType] -> ShowS
show :: DragType -> String
$cshow :: DragType -> String
showsPrec :: Int -> DragType -> ShowS
$cshowsPrec :: Int -> DragType -> ShowS
Show, ReadPrec [DragType]
ReadPrec DragType
Int -> ReadS DragType
ReadS [DragType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DragType]
$creadListPrec :: ReadPrec [DragType]
readPrec :: ReadPrec DragType
$creadPrec :: ReadPrec DragType
readList :: ReadS [DragType]
$creadList :: ReadS [DragType]
readsPrec :: Int -> ReadS DragType
$creadsPrec :: Int -> ReadS DragType
Read )

instance LayoutClass DragPane a where
    doLayout :: DragPane a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
doLayout d :: DragPane a
d@(DragPane Invisible Maybe (Window, Rectangle, Int)
_ DragType
Vertical   Double
_ Double
_) = forall a.
(Rectangle -> Rectangle)
-> DragPane a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (DragPane a))
doLay forall a. a -> a
id DragPane a
d
    doLayout d :: DragPane a
d@(DragPane Invisible Maybe (Window, Rectangle, Int)
_ DragType
Horizontal Double
_ Double
_) = forall a.
(Rectangle -> Rectangle)
-> DragPane a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (DragPane a))
doLay Rectangle -> Rectangle
mirrorRect DragPane a
d
    handleMessage :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))
handleMessage = forall a. DragPane a -> SomeMessage -> X (Maybe (DragPane a))
handleMess

data SetFrac = SetFrac Int Double deriving ( Int -> SetFrac -> ShowS
[SetFrac] -> ShowS
SetFrac -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetFrac] -> ShowS
$cshowList :: [SetFrac] -> ShowS
show :: SetFrac -> String
$cshow :: SetFrac -> String
showsPrec :: Int -> SetFrac -> ShowS
$cshowsPrec :: Int -> SetFrac -> ShowS
Show, ReadPrec [SetFrac]
ReadPrec SetFrac
Int -> ReadS SetFrac
ReadS [SetFrac]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetFrac]
$creadListPrec :: ReadPrec [SetFrac]
readPrec :: ReadPrec SetFrac
$creadPrec :: ReadPrec SetFrac
readList :: ReadS [SetFrac]
$creadList :: ReadS [SetFrac]
readsPrec :: Int -> ReadS SetFrac
$creadsPrec :: Int -> ReadS SetFrac
Read, SetFrac -> SetFrac -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetFrac -> SetFrac -> Bool
$c/= :: SetFrac -> SetFrac -> Bool
== :: SetFrac -> SetFrac -> Bool
$c== :: SetFrac -> SetFrac -> Bool
Eq)
instance Message SetFrac

handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))
handleMess :: forall a. DragPane a -> SomeMessage -> X (Maybe (DragPane a))
handleMess d :: DragPane a
d@(DragPane mb :: Invisible Maybe (Window, Rectangle, Int)
mb@(I (Just (Window
win,Rectangle
_,Int
ident))) DragType
ty Double
delta Double
split) SomeMessage
x
    | Just Event
e <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
x :: Maybe Event = do forall a. DragPane a -> Event -> X ()
handleEvent DragPane a
d Event
e
                                                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    | Just LayoutMessages
Hide             <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
x = do Window -> X ()
hideWindow Window
win
                                                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane Invisible Maybe (Window, Rectangle, Int)
mb DragType
ty Double
delta Double
split)
    | Just LayoutMessages
ReleaseResources <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
x = do Window -> X ()
deleteWindow Window
win
                                                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) DragType
ty Double
delta Double
split)
    -- layout specific messages
    | Just Resize
Shrink <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
x = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane Invisible Maybe (Window, Rectangle, Int)
mb DragType
ty Double
delta (Double
split forall a. Num a => a -> a -> a
- Double
delta))
    | Just Resize
Expand <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
x = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane Invisible Maybe (Window, Rectangle, Int)
mb DragType
ty Double
delta (Double
split forall a. Num a => a -> a -> a
+ Double
delta))
    | Just (SetFrac Int
ident' Double
frac) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
x, Int
ident' forall a. Eq a => a -> a -> Bool
== Int
ident =
                                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane Invisible Maybe (Window, Rectangle, Int)
mb DragType
ty Double
delta Double
frac)
handleMess DragPane a
_ SomeMessage
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

handleEvent :: DragPane a -> Event -> X ()
handleEvent :: forall a. DragPane a -> Event -> X ()
handleEvent (DragPane (I (Just (Window
win,Rectangle
r,Int
ident))) DragType
ty Double
_ Double
_)
            ButtonEvent{ev_window :: Event -> Window
ev_window = Window
thisw, ev_subwindow :: Event -> Window
ev_subwindow = Window
thisbw, ev_event_type :: Event -> EventType
ev_event_type = EventType
t }
    | EventType
t forall a. Eq a => a -> a -> Bool
== EventType
buttonPress Bool -> Bool -> Bool
&& Window
thisw forall a. Eq a => a -> a -> Bool
== Window
win Bool -> Bool -> Bool
|| Window
thisbw forall a. Eq a => a -> a -> Bool
== Window
win  =
  (Position -> Position -> X ()) -> X () -> X ()
mouseDrag (\Position
ex Position
ey -> do
             let frac :: Double
frac = case DragType
ty of
                        DragType
Vertical   -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
ex forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Position
rect_x Rectangle
r))forall a. Fractional a => a -> a -> a
/forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> EventType
rect_width  Rectangle
r)
                        DragType
Horizontal -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
ey forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Position
rect_x Rectangle
r))forall a. Fractional a => a -> a -> a
/forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> EventType
rect_width Rectangle
r)
             forall a. Message a => a -> X ()
sendMessage (Int -> Double -> SetFrac
SetFrac Int
ident Double
frac))
            (forall (m :: * -> *) a. Monad m => a -> m a
return ())
handleEvent DragPane a
_ Event
_  = forall (m :: * -> *) a. Monad m => a -> m a
return ()

doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
doLay :: forall a.
(Rectangle -> Rectangle)
-> DragPane a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (DragPane a))
doLay Rectangle -> Rectangle
mirror (DragPane Invisible Maybe (Window, Rectangle, Int)
mw DragType
ty Double
delta Double
split) Rectangle
r Stack a
s = do
  let r' :: Rectangle
r' = Rectangle -> Rectangle
mirror Rectangle
r
      (Rectangle
left', Rectangle
right') = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Double
split Rectangle
r'
      left :: Rectangle
left = case Rectangle
left' of Rectangle Position
x Position
y EventType
w EventType
h ->
                               Rectangle -> Rectangle
mirror forall a b. (a -> b) -> a -> b
$ Position -> Position -> EventType -> EventType -> Rectangle
Rectangle Position
x Position
y (EventType
wforall a. Num a => a -> a -> a
-forall a. Integral a => a
halfHandleWidth) EventType
h
      right :: Rectangle
right = case Rectangle
right' of
                Rectangle Position
x Position
y EventType
w EventType
h ->
                    Rectangle -> Rectangle
mirror forall a b. (a -> b) -> a -> b
$ Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (Position
xforall a. Num a => a -> a -> a
+forall a. Integral a => a
halfHandleWidth) Position
y (EventType
wforall a. Num a => a -> a -> a
-forall a. Integral a => a
halfHandleWidth) EventType
h
      handr :: Rectangle
handr = case Rectangle
left' of
                Rectangle Position
x Position
y EventType
w EventType
h ->
                    Rectangle -> Rectangle
mirror forall a b. (a -> b) -> a -> b
$ Position -> Position -> EventType -> EventType -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral EventType
w forall a. Num a => a -> a -> a
- forall a. Integral a => a
halfHandleWidth) Position
y (EventType
2forall a. Num a => a -> a -> a
*forall a. Integral a => a
halfHandleWidth) EventType
h
      wrs :: [(a, Rectangle)]
wrs = case forall a. [a] -> [a]
reverse (forall a. Stack a -> [a]
W.up Stack a
s) of
              (a
master:[a]
_) -> [(a
master,Rectangle
left),(forall a. Stack a -> a
W.focus Stack a
s,Rectangle
right)]
              [] -> case forall a. Stack a -> [a]
W.down Stack a
s of
                      (a
next:[a]
_) -> [(forall a. Stack a -> a
W.focus Stack a
s,Rectangle
left),(a
next,Rectangle
right)]
                      [] -> [(forall a. Stack a -> a
W.focus Stack a
s, Rectangle
r)]
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, Rectangle)]
wrs forall a. Ord a => a -> a -> Bool
> Int
1
     then case Invisible Maybe (Window, Rectangle, Int)
mw of
            I (Just (Window
w,Rectangle
_,Int
ident)) -> do
                    Window
w' <- Window -> X ()
deleteWindow Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rectangle -> X Window
newDragWin Rectangle
handr
                    forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane (forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Window
w',Rectangle
r',Int
ident)) DragType
ty Double
delta Double
split)
            I Maybe (Window, Rectangle, Int)
Nothing -> do
                    Window
w <- Rectangle -> X Window
newDragWin Rectangle
handr
                    Unique
i <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO Unique
newUnique
                    forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
Invisible Maybe (Window, Rectangle, Int)
-> DragType -> Double -> Double -> DragPane a
DragPane (forall (m :: * -> *) a. m a -> Invisible m a
I forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Window
w,Rectangle
r',Unique -> Int
hashUnique Unique
i)) DragType
ty Double
delta Double
split)
     else forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. Maybe a
Nothing)


newDragWin :: Rectangle -> X Window
newDragWin :: Rectangle -> X Window
newDragWin Rectangle
r = do
  let mask :: Maybe Window
mask = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Window
exposureMask forall a. Bits a => a -> a -> a
.|. Window
buttonPressMask
  Window
w <- Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow Rectangle
r Maybe Window
mask String
handleColor Bool
False
  Window -> X ()
showWindow  Window
w
  Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
lowerWindow Display
d Window
w
  forall (m :: * -> *) a. Monad m => a -> m a
return      Window
w