{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE TypeSynonymInstances       #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Magnifier
-- Description :  Increase the size of the window that has focus.
-- Copyright   :  (c) Peter De Wachter and Andrea Rossato 2007
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a layout modifier that will make a layout change the size of
-- the window that has focus.
--
-- [Example screenshot using @magnifiercz' 1.3@ with one of the two stack windows focused.](https://user-images.githubusercontent.com/50166980/108524842-c5f69380-72cf-11eb-9fd6-b0bf67b13ed6.png)
--
-----------------------------------------------------------------------------


module XMonad.Layout.Magnifier
    ( -- * Usage
      -- $usage

      -- * General combinators
      magnify,

      -- * Magnify Everything
      magnifier,
      magnifierOff,
      magnifiercz,
      magnifierczOff,
      maxMagnifierOff,
      maximizeVertical,

      -- * Don't Magnify the Master Window
      magnifier',
      magnifiercz',
      magnifierczOff',

      -- * Messages and Types
      MagnifyMsg (..),
      MagnifyThis(..),
      Magnifier,
    ) where

import Numeric.Natural (Natural)

import XMonad
import XMonad.Prelude (bool, fi)
import XMonad.Layout.LayoutModifier
import XMonad.StackSet

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Magnifier
--
-- Then edit your @layoutHook@ by e.g. adding the 'magnifier' layout
-- modifier to some layout:
--
-- > myLayout = magnifier (Tall 1 (3/100) (1/2))  ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- By default 'magnifier' increases the focused window's size by @1.5@.
--
-- You can also use @'magnifiercz' 1.2@ to use a custom level of
-- magnification.  You can even make the focused window smaller for a
-- pop in effect.  There's also the possibility of starting out not
-- magnifying anything at all ('magnifierOff'); see below for ways to
-- toggle this on while in use.
--
-- The most general combinator available is 'magnify'—all of the other
-- functions in this module are essentially just creative applications
-- of it.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- Magnifier supports some commands, see 'MagnifyMsg'.  To use them add
-- something like this to your key bindings:
--
-- >    , ((modm .|. controlMask              , xK_plus ), sendMessage MagnifyMore)
-- >    , ((modm .|. controlMask              , xK_minus), sendMessage MagnifyLess)
-- >    , ((modm .|. controlMask              , xK_o    ), sendMessage ToggleOff  )
-- >    , ((modm .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )
-- >    , ((modm .|. controlMask              , xK_m    ), sendMessage Toggle     )
--
-- Note that a few other extension modules, such as
-- "XMonad.Layout.MultiToggle" and "XMonad.Layout.ToggleLayouts", also
-- define a message named 'Toggle'.  To avoid conflicts when using
-- these modules together, you can import Magnifier qualified, like
-- this:
--
-- > import qualified XMonad.Layout.Magnifier as Mag
--
-- and then prefix @Mag@ to the front of everything from this module,
-- like @Mag.Toggle@, @Mag.magnifier@, and so on.
--
-- For detailed instruction on editing the key binding see
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- | Add magnification capabilities to a certain layout.
--
-- For example, to re-create 'magnifiercz' 1.3', you would do
--
-- >>> magnify 1.3 (NoMaster 1) True
--
magnify
    :: Rational     -- ^ Amount to magnify both directions
    -> MagnifyThis  -- ^ What to magnify
    -> Bool         -- ^ Whether magnification should start out on
                    --   (@True@) or off (@False@)
    -> l a          -- ^ Input layout
    -> ModifiedLayout Magnifier l a
magnify :: forall (l :: * -> *) a.
Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
magnify Rational
cz MagnifyThis
mt Bool
start = Magnifier a -> l a -> ModifiedLayout Magnifier l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Magnifier a -> l a -> ModifiedLayout Magnifier l a)
-> Magnifier a -> l a -> ModifiedLayout Magnifier l a
forall a b. (a -> b) -> a -> b
$
    Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
1 (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
cz, Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
cz) (Toggle -> Toggle -> Bool -> Toggle
forall a. a -> a -> Bool -> a
bool Toggle
Off Toggle
On Bool
start) MagnifyThis
mt

-- | Increase the size of the window that has focus
magnifier :: l a -> ModifiedLayout Magnifier l a
magnifier :: forall (l :: * -> *) a. l a -> ModifiedLayout Magnifier l a
magnifier = Rational -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz Rational
1.5

-- | Change the size of the window that has focus by a custom zoom
magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz :: forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz Rational
cz = Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
magnify Rational
cz (Natural -> MagnifyThis
AllWins Natural
1) Bool
True

-- | Increase the size of the window that has focus, unless if it is one of the
-- master windows.
magnifier' :: l a -> ModifiedLayout Magnifier l a
magnifier' :: forall (l :: * -> *) a. l a -> ModifiedLayout Magnifier l a
magnifier' = Rational -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz' Rational
1.5

-- | Increase the size of the window that has focus by a custom zoom,
-- unless if it is one of the the master windows.
magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz' :: forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz' Rational
cz = Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
magnify Rational
cz (Natural -> MagnifyThis
NoMaster Natural
1) Bool
True

-- | Magnifier that defaults to Off
magnifierOff :: l a -> ModifiedLayout Magnifier l a
magnifierOff :: forall (l :: * -> *) a. l a -> ModifiedLayout Magnifier l a
magnifierOff = Rational -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifierczOff Rational
1.5

-- | A magnifier that greatly magnifies the focused window; defaults to
-- @Off@.
maxMagnifierOff :: l a -> ModifiedLayout Magnifier l a
maxMagnifierOff :: forall (l :: * -> *) a. l a -> ModifiedLayout Magnifier l a
maxMagnifierOff = Rational -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifierczOff Rational
1000

-- | Like 'magnifiercz', but default to @Off@.
magnifierczOff :: Rational -> l a -> ModifiedLayout Magnifier l a
magnifierczOff :: forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifierczOff Rational
cz = Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
magnify Rational
cz (Natural -> MagnifyThis
AllWins Natural
1) Bool
False

-- | Like 'magnifiercz'', but default to @Off@.
magnifierczOff' :: Rational -> l a -> ModifiedLayout Magnifier l a
magnifierczOff' :: forall (l :: * -> *) a.
Rational -> l a -> ModifiedLayout Magnifier l a
magnifierczOff' Rational
cz = Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
forall (l :: * -> *) a.
Rational
-> MagnifyThis -> Bool -> l a -> ModifiedLayout Magnifier l a
magnify Rational
cz (Natural -> MagnifyThis
NoMaster Natural
1) Bool
False

-- | A magnifier that greatly magnifies just the vertical direction
maximizeVertical :: l a -> ModifiedLayout Magnifier l a
maximizeVertical :: forall (l :: * -> *) a. l a -> ModifiedLayout Magnifier l a
maximizeVertical = Magnifier a -> l a -> ModifiedLayout Magnifier l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
1 (Double
1, Double
1000) Toggle
Off (Natural -> MagnifyThis
AllWins Natural
1))

data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle
instance Message MagnifyMsg

-- | The type for magnifying a given type; do note that the given type
-- @a@ is a phantom type.
data Magnifier a = Mag
    { forall a. Magnifier a -> Int
masterWins :: !Int
      -- ^ How many windows there are in the master pane.
    , forall a. Magnifier a -> (Double, Double)
zoomFactor :: !(Double, Double)
      -- ^ Zoom-factor in the @x@ and @y@ direction; the window's width and
      --   height will be multiplied by these amounts when magnifying.
    , forall a. Magnifier a -> Toggle
toggle :: !Toggle
      -- ^ Whether to magnify windows at all.
    , forall a. Magnifier a -> MagnifyThis
magWhen :: !MagnifyThis
      -- ^ Conditions when to magnify a given window
    }
    deriving (ReadPrec [Magnifier a]
ReadPrec (Magnifier a)
Int -> ReadS (Magnifier a)
ReadS [Magnifier a]
(Int -> ReadS (Magnifier a))
-> ReadS [Magnifier a]
-> ReadPrec (Magnifier a)
-> ReadPrec [Magnifier a]
-> Read (Magnifier a)
forall a. ReadPrec [Magnifier a]
forall a. ReadPrec (Magnifier a)
forall a. Int -> ReadS (Magnifier a)
forall a. ReadS [Magnifier a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Magnifier a]
$creadListPrec :: forall a. ReadPrec [Magnifier a]
readPrec :: ReadPrec (Magnifier a)
$creadPrec :: forall a. ReadPrec (Magnifier a)
readList :: ReadS [Magnifier a]
$creadList :: forall a. ReadS [Magnifier a]
readsPrec :: Int -> ReadS (Magnifier a)
$creadsPrec :: forall a. Int -> ReadS (Magnifier a)
Read, Int -> Magnifier a -> ShowS
[Magnifier a] -> ShowS
Magnifier a -> String
(Int -> Magnifier a -> ShowS)
-> (Magnifier a -> String)
-> ([Magnifier a] -> ShowS)
-> Show (Magnifier a)
forall a. Int -> Magnifier a -> ShowS
forall a. [Magnifier a] -> ShowS
forall a. Magnifier a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Magnifier a] -> ShowS
$cshowList :: forall a. [Magnifier a] -> ShowS
show :: Magnifier a -> String
$cshow :: forall a. Magnifier a -> String
showsPrec :: Int -> Magnifier a -> ShowS
$cshowsPrec :: forall a. Int -> Magnifier a -> ShowS
Show)

-- | Whether magnification is currently enabled.
data Toggle = On | Off deriving (ReadPrec [Toggle]
ReadPrec Toggle
Int -> ReadS Toggle
ReadS [Toggle]
(Int -> ReadS Toggle)
-> ReadS [Toggle]
-> ReadPrec Toggle
-> ReadPrec [Toggle]
-> Read Toggle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Toggle]
$creadListPrec :: ReadPrec [Toggle]
readPrec :: ReadPrec Toggle
$creadPrec :: ReadPrec Toggle
readList :: ReadS [Toggle]
$creadList :: ReadS [Toggle]
readsPrec :: Int -> ReadS Toggle
$creadsPrec :: Int -> ReadS Toggle
Read, Int -> Toggle -> ShowS
[Toggle] -> ShowS
Toggle -> String
(Int -> Toggle -> ShowS)
-> (Toggle -> String) -> ([Toggle] -> ShowS) -> Show Toggle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Toggle] -> ShowS
$cshowList :: [Toggle] -> ShowS
show :: Toggle -> String
$cshow :: Toggle -> String
showsPrec :: Int -> Toggle -> ShowS
$cshowsPrec :: Int -> Toggle -> ShowS
Show)

-- | Which windows to magnify and when to start doing so.  Note that
-- magnifying will start /at/ the cut-off, so @AllWins 3@ will start
-- magnifying when there are at least three windows present in the stack
-- set.
data MagnifyThis
    = AllWins  !Natural  -- ^ Every window
    | NoMaster !Natural  -- ^ Only stack windows
    deriving (ReadPrec [MagnifyThis]
ReadPrec MagnifyThis
Int -> ReadS MagnifyThis
ReadS [MagnifyThis]
(Int -> ReadS MagnifyThis)
-> ReadS [MagnifyThis]
-> ReadPrec MagnifyThis
-> ReadPrec [MagnifyThis]
-> Read MagnifyThis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MagnifyThis]
$creadListPrec :: ReadPrec [MagnifyThis]
readPrec :: ReadPrec MagnifyThis
$creadPrec :: ReadPrec MagnifyThis
readList :: ReadS [MagnifyThis]
$creadList :: ReadS [MagnifyThis]
readsPrec :: Int -> ReadS MagnifyThis
$creadsPrec :: Int -> ReadS MagnifyThis
Read, Int -> MagnifyThis -> ShowS
[MagnifyThis] -> ShowS
MagnifyThis -> String
(Int -> MagnifyThis -> ShowS)
-> (MagnifyThis -> String)
-> ([MagnifyThis] -> ShowS)
-> Show MagnifyThis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MagnifyThis] -> ShowS
$cshowList :: [MagnifyThis] -> ShowS
show :: MagnifyThis -> String
$cshow :: MagnifyThis -> String
showsPrec :: Int -> MagnifyThis -> ShowS
$cshowsPrec :: Int -> MagnifyThis -> ShowS
Show)

instance LayoutModifier Magnifier Window where
    redoLayout :: Magnifier Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
redoLayout Magnifier Window
_   Rectangle
_ Maybe (Stack Window)
Nothing  [(Window, Rectangle)]
wrs = ([(Window, Rectangle)], Maybe (Magnifier Window))
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Window, Rectangle)]
wrs, Maybe (Magnifier Window)
forall a. Maybe a
Nothing)
    redoLayout Magnifier Window
mag Rectangle
r (Just Stack Window
s) [(Window, Rectangle)]
wrs = case Magnifier Window
mag of
        Mag Int
_ (Double, Double)
z Toggle
On (AllWins  Natural
k) -> Natural
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
forall {a} {f :: * -> *} {a}.
(Integral a, Applicative f) =>
a
-> f ([(Window, Rectangle)], Maybe a)
-> f ([(Window, Rectangle)], Maybe a)
magnifyAt Natural
k ((Double, Double)
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
forall t a.
(Double, Double)
-> Rectangle
-> t
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe a)
applyMagnifier (Double, Double)
z Rectangle
r Stack Window
s [(Window, Rectangle)]
wrs)
        Mag Int
n (Double, Double)
z Toggle
On (NoMaster Natural
k) ->
            Natural
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
forall {a} {f :: * -> *} {a}.
(Integral a, Applicative f) =>
a
-> f ([(Window, Rectangle)], Maybe a)
-> f ([(Window, Rectangle)], Maybe a)
magnifyAt Natural
k (Int
-> (Rectangle
    -> Stack Window
    -> [(Window, Rectangle)]
    -> X ([(Window, Rectangle)], Maybe (Magnifier Window)))
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
forall a. Int -> NewLayout a -> NewLayout a
unlessMaster Int
n ((Double, Double)
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
forall t a.
(Double, Double)
-> Rectangle
-> t
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe a)
applyMagnifier (Double, Double)
z) Rectangle
r Stack Window
s [(Window, Rectangle)]
wrs)
        Magnifier Window
_ -> ([(Window, Rectangle)], Maybe (Magnifier Window))
-> X ([(Window, Rectangle)], Maybe (Magnifier Window))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Window, Rectangle)]
wrs, Maybe (Magnifier Window)
forall a. Maybe a
Nothing)
      where
        magnifyAt :: a
-> f ([(Window, Rectangle)], Maybe a)
-> f ([(Window, Rectangle)], Maybe a)
magnifyAt a
cutoff f ([(Window, Rectangle)], Maybe a)
magnifyFun
            | a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
cutoff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Stack Window -> [Window]
forall a. Stack a -> [a]
integrate Stack Window
s) = f ([(Window, Rectangle)], Maybe a)
magnifyFun
            | Bool
otherwise                                   = ([(Window, Rectangle)], Maybe a)
-> f ([(Window, Rectangle)], Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Window, Rectangle)]
wrs, Maybe a
forall a. Maybe a
Nothing)

    handleMess :: Magnifier Window -> SomeMessage -> X (Maybe (Magnifier Window))
handleMess (Mag Int
n (Double, Double)
z Toggle
On  MagnifyThis
t) SomeMessage
m
        | Just MagnifyMsg
MagnifyMore    <- SomeMessage -> Maybe MagnifyMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
n             ((Double, Double)
z (Double, Double) -> Double -> (Double, Double)
forall {b}. Num b => (b, b) -> b -> (b, b)
`addto`   Double
0.1 ) Toggle
On  MagnifyThis
t
        | Just MagnifyMsg
MagnifyLess    <- SomeMessage -> Maybe MagnifyMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
n             ((Double, Double)
z (Double, Double) -> Double -> (Double, Double)
forall {b}. Num b => (b, b) -> b -> (b, b)
`addto` (-Double
0.1)) Toggle
On  MagnifyThis
t
        | Just MagnifyMsg
ToggleOff      <- SomeMessage -> Maybe MagnifyMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
n             (Double, Double)
z                  Toggle
Off MagnifyThis
t
        | Just MagnifyMsg
Toggle         <- SomeMessage -> Maybe MagnifyMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
n             (Double, Double)
z                  Toggle
Off MagnifyThis
t
        | Just (IncMasterN Int
d) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) (Double, Double)
z                  Toggle
On  MagnifyThis
t
      where addto :: (b, b) -> b -> (b, b)
addto (b
x, b
y) b
i = (b
x b -> b -> b
forall a. Num a => a -> a -> a
+ b
i, b
y b -> b -> b
forall a. Num a => a -> a -> a
+ b
i)
    handleMess (Mag Int
n (Double, Double)
z Toggle
Off MagnifyThis
t) SomeMessage
m
        | Just MagnifyMsg
ToggleOn       <- SomeMessage -> Maybe MagnifyMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
n             (Double, Double)
z                  Toggle
On  MagnifyThis
t
        | Just MagnifyMsg
Toggle         <- SomeMessage -> Maybe MagnifyMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag Int
n             (Double, Double)
z                  Toggle
On  MagnifyThis
t
        | Just (IncMasterN Int
d) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Magnifier Window) -> X (Maybe (Magnifier Window)))
-> (Magnifier Window -> Maybe (Magnifier Window))
-> Magnifier Window
-> X (Maybe (Magnifier Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Magnifier Window -> Maybe (Magnifier Window)
forall a. a -> Maybe a
Just (Magnifier Window -> X (Maybe (Magnifier Window)))
-> Magnifier Window -> X (Maybe (Magnifier Window))
forall a b. (a -> b) -> a -> b
$ Int
-> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier Window
forall a.
Int -> (Double, Double) -> Toggle -> MagnifyThis -> Magnifier a
Mag (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) (Double, Double)
z                  Toggle
Off MagnifyThis
t
    handleMess Magnifier Window
_ SomeMessage
_ = Maybe (Magnifier Window) -> X (Maybe (Magnifier Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Magnifier Window)
forall a. Maybe a
Nothing

    modifierDescription :: Magnifier Window -> String
modifierDescription (Mag Int
_ (Double, Double)
_ Toggle
On  AllWins{} ) = String
"Magnifier"
    modifierDescription (Mag Int
_ (Double, Double)
_ Toggle
On  NoMaster{}) = String
"Magnifier NoMaster"
    modifierDescription (Mag Int
_ (Double, Double)
_ Toggle
Off MagnifyThis
_         ) = String
"Magnifier (off)"

type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a))

unlessMaster :: Int -> NewLayout a -> NewLayout a
unlessMaster :: forall a. Int -> NewLayout a -> NewLayout a
unlessMaster Int
n NewLayout a
mainmod Rectangle
r Stack a
s [(Window, Rectangle)]
wrs = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s)) then ([(Window, Rectangle)], Maybe (Magnifier a))
-> X ([(Window, Rectangle)], Maybe (Magnifier a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wrs, Maybe (Magnifier a)
forall a. Maybe a
Nothing)
                                                             else NewLayout a
mainmod Rectangle
r Stack a
s [(Window, Rectangle)]
wrs

applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)]
               -> X ([(Window, Rectangle)], Maybe a)
applyMagnifier :: forall t a.
(Double, Double)
-> Rectangle
-> t
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe a)
applyMagnifier (Double, Double)
z Rectangle
r t
_ [(Window, Rectangle)]
wrs = do Maybe Window
focused <- (WindowSet -> X (Maybe Window)) -> X (Maybe Window)
forall a. (WindowSet -> X a) -> X a
withWindowSet (Maybe Window -> X (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> X (Maybe Window))
-> (WindowSet -> Maybe Window) -> WindowSet -> X (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek)
                              let mag :: (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
mag (Window
w,Rectangle
wr) [(Window, Rectangle)]
ws | Maybe Window
focused Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w = [(Window, Rectangle)]
ws [(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [(Window
w, Rectangle -> Rectangle -> Rectangle
fit Rectangle
r (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Rectangle -> Rectangle
magnify' (Double, Double)
z Rectangle
wr)]
                                                | Bool
otherwise         = (Window
w,Rectangle
wr) (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
ws
                              ([(Window, Rectangle)], Maybe a)
-> X ([(Window, Rectangle)], Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a]
reverse ([(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ ((Window, Rectangle)
 -> [(Window, Rectangle)] -> [(Window, Rectangle)])
-> [(Window, Rectangle)]
-> [(Window, Rectangle)]
-> [(Window, Rectangle)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
mag [] [(Window, Rectangle)]
wrs, Maybe a
forall a. Maybe a
Nothing)

magnify' :: (Double, Double) -> Rectangle -> Rectangle
magnify' :: (Double, Double) -> Rectangle -> Rectangle
magnify' (Double
zoomx,Double
zoomy) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x' Position
y' Dimension
w' Dimension
h'
    where x' :: Position
x' = Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
w' Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
w) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
          y' :: Position
y' = Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
h' Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
h) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
          w' :: Dimension
w' = Double -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Dimension) -> Double -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoomx
          h' :: Dimension
h' = Double -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Dimension) -> Double -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zoomy

fit :: Rectangle -> Rectangle -> Rectangle
fit :: Rectangle -> Rectangle -> Rectangle
fit (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x' Position
y' Dimension
w' Dimension
h'
    where x' :: Position
x' = Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
sx (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
0 (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
sw))
          y' :: Position
y' = Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
sy (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
0 (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
sh))
          w' :: Dimension
w' = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
sw Dimension
w
          h' :: Dimension
h' = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
sh Dimension
h