{-# 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String -> X ()) -> String -> X ()
forall a b. (a -> b) -> a -> b
$ String
"Can't layoutScreens with only " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nscr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" screens."
layoutScreens Int
nscr l Int
l = (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot X Window -> (Window -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d ->
  Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w ((WindowAttributes -> X ()) -> X ())
-> (WindowAttributes -> X ()) -> X ()
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)
_) <- Workspace String (l Int) Int
-> Rectangle -> X ([(Int, Rectangle)], Maybe (l Int))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Int -> Maybe (Stack Int) -> Workspace String (l Int) Int
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
"" l Int
l (Stack Int -> Maybe (Stack Int)
forall a. a -> Maybe a
Just (Stack Int -> Maybe (Stack Int)) -> Stack Int -> Maybe (Stack Int)
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
nscrInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] })) Rectangle
rtrect
       (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
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 = Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
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) = Int
-> [Workspace String (Layout Window) Window]
-> ([Workspace String (Layout Window) Window],
    [Workspace String (Layout Window) Window])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nscr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Workspace String (Layout Window) Window]
 -> ([Workspace String (Layout Window) Window],
     [Workspace String (Layout Window) Window]))
-> [Workspace String (Layout Window) Window]
-> ([Workspace String (Layout Window) Window],
    [Workspace String (Layout Window) Window])
forall a b. (a -> b) -> a -> b
$ (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Workspace String (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
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 [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
forall a. [a] -> [a] -> [a]
++ [Workspace String (Layout Window) Window]
hs
               ([Rectangle] -> NonEmpty Rectangle
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Rectangle
s :| [Rectangle]
ss) = ((Int, Rectangle) -> Rectangle)
-> [(Int, Rectangle)] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd [(Int, Rectangle)]
wss
           in  WindowSet
ws { W.current = W.Screen x 0 (SD s)
                  , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss
                  , W.hidden  = 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String -> X ()) -> String -> X ()
forall a b. (a -> b) -> a -> b
$ String
"Can't layoutSplitScreen with only " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nscr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" screens."
layoutSplitScreen Int
nscr l Int
l =
    do Rectangle
rect <- (XState -> Rectangle) -> X Rectangle
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Rectangle) -> X Rectangle)
-> (XState -> Rectangle) -> X Rectangle
forall a b. (a -> b) -> a -> b
$ ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (XState -> ScreenDetail) -> XState -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> ScreenDetail)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState -> WindowSet)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
       ([(Int, Rectangle)]
wss, Maybe (l Int)
_) <- Workspace String (l Int) Int
-> Rectangle -> X ([(Int, Rectangle)], Maybe (l Int))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Int -> Maybe (Stack Int) -> Workspace String (l Int) Int
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
"" l Int
l (Stack Int -> Maybe (Stack Int)
forall a. a -> Maybe a
Just (Stack Int -> Maybe (Stack Int)) -> Stack Int -> Maybe (Stack Int)
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
nscrInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] })) Rectangle
rect
       (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
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 = Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
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) = Int
-> [Workspace String (Layout Window) Window]
-> ([Workspace String (Layout Window) Window],
    [Workspace String (Layout Window) Window])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nscr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Workspace String (Layout Window) Window]
hs
               ([Rectangle] -> NonEmpty Rectangle
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Rectangle
s :| [Rectangle]
ss) = ((Int, Rectangle) -> Rectangle)
-> [(Int, Rectangle)] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd [(Int, Rectangle)]
wss
           in  WindowSet
ws { W.current = W.Screen x (W.screen c) (SD s)
                  , W.visible = zipWith3 W.Screen xs [(W.screen c+1) ..] (map SD ss) ++
                                map (\Screen String (Layout Window) Window ScreenId ScreenDetail
v -> if Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen String (Layout Window) Window ScreenId ScreenDetail
vScreenId -> ScreenId -> Bool
forall a. Ord a => a -> a -> Bool
>Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
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{W.screen = W.screen v + fromIntegral (nscr-1)} else Screen String (Layout Window) Window ScreenId ScreenDetail
v) vs
                  , W.hidden  = ys }

windowRectangle :: WindowAttributes -> Rectangle
windowRectangle :: WindowAttributes -> Rectangle
windowRectangle WindowAttributes
a = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
a)     (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
a)
                              (CInt -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Dimension) -> CInt -> Dimension
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
a) (CInt -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Dimension) -> CInt -> Dimension
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)
Int -> ReadS (FixedLayout a)
ReadS [FixedLayout a]
(Int -> ReadS (FixedLayout a))
-> ReadS [FixedLayout a]
-> ReadPrec (FixedLayout a)
-> ReadPrec [FixedLayout a]
-> Read (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
$creadsPrec :: forall a. Int -> ReadS (FixedLayout a)
readsPrec :: Int -> ReadS (FixedLayout a)
$creadList :: forall a. ReadS [FixedLayout a]
readList :: ReadS [FixedLayout a]
$creadPrec :: forall a. ReadPrec (FixedLayout a)
readPrec :: ReadPrec (FixedLayout a)
$creadListPrec :: forall a. ReadPrec [FixedLayout a]
readListPrec :: ReadPrec [FixedLayout a]
Read,Int -> FixedLayout a -> String -> String
[FixedLayout a] -> String -> String
FixedLayout a -> String
(Int -> FixedLayout a -> String -> String)
-> (FixedLayout a -> String)
-> ([FixedLayout a] -> String -> String)
-> Show (FixedLayout a)
forall a. Int -> FixedLayout a -> String -> String
forall a. [FixedLayout a] -> String -> String
forall a. FixedLayout a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Int -> FixedLayout a -> String -> String
showsPrec :: Int -> FixedLayout a -> String -> String
$cshow :: forall a. FixedLayout a -> String
show :: FixedLayout a -> String
$cshowList :: forall a. [FixedLayout a] -> String -> String
showList :: [FixedLayout a] -> String -> String
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 = ([(a, Rectangle)], Maybe (FixedLayout a))
-> X ([(a, Rectangle)], Maybe (FixedLayout a))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
s) [Rectangle]
rs, Maybe (FixedLayout a)
forall a. Maybe a
Nothing)

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