{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.LayoutScreens
-- Description :  A layout to divide a single screen into multiple screens.
-- Copyright   :  (c) David Roundy <droundy@darcs.net>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  none
-- Stability   :  unstable
-- Portability :  unportable
--
-- Divide a single screen into multiple screens.
-----------------------------------------------------------------------------

module XMonad.Layout.LayoutScreens (
                                    -- * Usage
                                    -- $usage
                                    layoutScreens, layoutSplitScreen, fixedLayout,
                                    FixedLayout,
                                   ) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W

-- $usage
-- This module allows you to pretend that you have more than one screen by
-- dividing a single screen into multiple screens that xmonad will treat as
-- separate screens.  This should definitely be useful for testing the
-- behavior of xmonad under Xinerama, and it's possible that it'd also be
-- handy for use as an actual user interface, if you've got a very large
-- screen and long for greater flexibility (e.g. being able to see your
-- email window at all times, a crude mimic of sticky windows).
--
-- You can use this module with the following in your
-- @xmonad.hs@ file:
--
-- > import XMonad.Layout.LayoutScreens
-- > import XMonad.Layout.TwoPane
--
-- Then add some keybindings; for example:
--
-- >   , ((modm .|. shiftMask,                 xK_space), layoutScreens 2 (TwoPane 0.5 0.5))
-- >   , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen)
--
-- Another example use would be to handle a scenario where xrandr didn't
-- work properly (e.g. a VNC X server in my case) and you want to be able
-- to resize your screen (e.g. to match the size of a remote VNC client):
--
-- > import XMonad.Layout.LayoutScreens
--
-- >   , ((modm .|. shiftMask, xK_space),
-- >        layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))
-- >   , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

-- | Modify all screens.
layoutScreens :: LayoutClass l Int => Int -> l Int -> X ()
layoutScreens :: forall (l :: * -> *). LayoutClass l Int => Int -> l Int -> X ()
layoutScreens Int
nscr l Int
_ | Int
nscr forall a. Ord a => a -> a -> Bool
< Int
1 = forall (m :: * -> *). MonadIO m => String -> m ()
trace forall a b. (a -> b) -> a -> b
$ String
"Can't layoutScreens with only " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nscr forall a. [a] -> [a] -> [a]
++ String
" screens."
layoutScreens Int
nscr l Int
l = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
  Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
attrs ->
    do let rtrect :: Rectangle
rtrect = WindowAttributes -> Rectangle
windowRectangle WindowAttributes
attrs
       ([(Int, Rectangle)]
wss, Maybe (l Int)
_) <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
"" l Int
l (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ W.Stack { focus :: Int
W.focus=Int
1, up :: [Int]
W.up=[],down :: [Int]
W.down=[Int
1..Int
nscrforall a. Num a => a -> a -> a
-Int
1] })) Rectangle
rtrect
       (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ \ws :: WindowSet
ws@W.StackSet{ current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current = Screen String (Layout Window) Window ScreenId ScreenDetail
v, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible = [Screen String (Layout Window) Window ScreenId ScreenDetail]
vs, hidden :: forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden = [Workspace String (Layout Window) Window]
hs } ->
           let x :: Workspace String (Layout Window) Window
x = forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen String (Layout Window) Window ScreenId ScreenDetail
v
               ([Workspace String (Layout Window) Window]
xs, [Workspace String (Layout Window) Window]
ys) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nscr forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace [Screen String (Layout Window) Window ScreenId ScreenDetail]
vs forall a. [a] -> [a] -> [a]
++ [Workspace String (Layout Window) Window]
hs
               (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Rectangle
s :| [Rectangle]
ss) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Rectangle)]
wss
           in  WindowSet
ws { current :: Screen String (Layout Window) Window ScreenId ScreenDetail
W.current = forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen Workspace String (Layout Window) Window
x ScreenId
0 (Rectangle -> ScreenDetail
SD Rectangle
s)
                  , visible :: [Screen String (Layout Window) Window ScreenId ScreenDetail]
W.visible = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen [Workspace String (Layout Window) Window]
xs [ScreenId
1 ..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> ScreenDetail
SD [Rectangle]
ss
                  , hidden :: [Workspace String (Layout Window) Window]
W.hidden  = [Workspace String (Layout Window) Window]
ys }

-- | Modify current screen.
layoutSplitScreen :: LayoutClass l Int => Int -> l Int -> X ()
layoutSplitScreen :: forall (l :: * -> *). LayoutClass l Int => Int -> l Int -> X ()
layoutSplitScreen Int
nscr l Int
_ | Int
nscr forall a. Ord a => a -> a -> Bool
< Int
1 = forall (m :: * -> *). MonadIO m => String -> m ()
trace forall a b. (a -> b) -> a -> b
$ String
"Can't layoutSplitScreen with only " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
nscr forall a. [a] -> [a] -> [a]
++ String
" screens."
layoutSplitScreen Int
nscr l Int
l =
    do Rectangle
rect <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
       ([(Int, Rectangle)]
wss, Maybe (l Int)
_) <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
"" l Int
l (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ W.Stack { focus :: Int
W.focus=Int
1, up :: [Int]
W.up=[],down :: [Int]
W.down=[Int
1..Int
nscrforall a. Num a => a -> a -> a
-Int
1] })) Rectangle
rect
       (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ \ws :: WindowSet
ws@W.StackSet{ current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current = Screen String (Layout Window) Window ScreenId ScreenDetail
c, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible = [Screen String (Layout Window) Window ScreenId ScreenDetail]
vs, hidden :: forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden = [Workspace String (Layout Window) Window]
hs } ->
           let x :: Workspace String (Layout Window) Window
x = forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen String (Layout Window) Window ScreenId ScreenDetail
c
               ([Workspace String (Layout Window) Window]
xs, [Workspace String (Layout Window) Window]
ys) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nscr forall a. Num a => a -> a -> a
- Int
1) [Workspace String (Layout Window) Window]
hs
               (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Rectangle
s :| [Rectangle]
ss) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Rectangle)]
wss
           in  WindowSet
ws { current :: Screen String (Layout Window) Window ScreenId ScreenDetail
W.current = forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen Workspace String (Layout Window) Window
x (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen String (Layout Window) Window ScreenId ScreenDetail
c) (Rectangle -> ScreenDetail
SD Rectangle
s)
                  , visible :: [Screen String (Layout Window) Window ScreenId ScreenDetail]
W.visible = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen [Workspace String (Layout Window) Window]
xs [(forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen String (Layout Window) Window ScreenId ScreenDetail
cforall a. Num a => a -> a -> a
+ScreenId
1) ..] (forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> ScreenDetail
SD [Rectangle]
ss) forall a. [a] -> [a] -> [a]
++
                                forall a b. (a -> b) -> [a] -> [b]
map (\Screen String (Layout Window) Window ScreenId ScreenDetail
v -> if forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen String (Layout Window) Window ScreenId ScreenDetail
vforall a. Ord a => a -> a -> Bool
>forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen String (Layout Window) Window ScreenId ScreenDetail
c then Screen String (Layout Window) Window ScreenId ScreenDetail
v{screen :: ScreenId
W.screen = forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen String (Layout Window) Window ScreenId ScreenDetail
v forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nscrforall a. Num a => a -> a -> a
-Int
1)} else Screen String (Layout Window) Window ScreenId ScreenDetail
v) [Screen String (Layout Window) Window ScreenId ScreenDetail]
vs
                  , hidden :: [Workspace String (Layout Window) Window]
W.hidden  = [Workspace String (Layout Window) Window]
ys }

windowRectangle :: WindowAttributes -> Rectangle
windowRectangle :: WindowAttributes -> Rectangle
windowRectangle WindowAttributes
a = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
a)     (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
a)
                              (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
a) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_height WindowAttributes
a)

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

instance LayoutClass FixedLayout a where
    doLayout :: FixedLayout a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (FixedLayout a))
doLayout (FixedLayout [Rectangle]
rs) Rectangle
_ Stack a
s = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Stack a -> [a]
W.integrate Stack a
s) [Rectangle]
rs, forall a. Maybe a
Nothing)

fixedLayout :: [Rectangle] -> FixedLayout a
fixedLayout :: forall a. [Rectangle] -> FixedLayout a
fixedLayout = forall a. [Rectangle] -> FixedLayout a
FixedLayout