{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.FixedAspectRatio
-- Description :  A layout modifier for user provided per-window aspect ratios.
-- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Layout modifier for user provided per-window aspect ratios.
--
-----------------------------------------------------------------------------

module XMonad.Layout.FixedAspectRatio
  (
    -- * Usage
    -- $usage
    fixedAspectRatio
  , FixedAspectRatio
  , ManageAspectRatio(..)
  , doFixAspect
  ) where


import           Control.Arrow
import qualified Data.Map                      as M
import           Data.Ratio

import           XMonad
import           XMonad.Actions.MessageFeedback
import           XMonad.Layout.Decoration
import           XMonad.Layout.LayoutHints

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.FixedAspectRatio
-- Then add it to your layout:
--
-- > myLayout = fixedAspectRatio (0.5, 0.5) $ Tall 1 (3/100) (1/2)  ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- Which will center the (eventually) shrinked windows in their assigned
-- rectangle.
--
-- For a layout modifier that automatically sets the aspect ratio
-- depending on the size hints (for example for programs like mpv),
-- see "XMonad.Layout.LayoutHints"
--
-- See <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook" for more info on the 'layoutHook'.
--
-- You also want to add keybindings to set and clear the aspect ratio:
--
-- >      -- Set the aspect ratio of the focused window to 16:9
-- >   ,((modm, xK_a), withFocused $ sendMessage . FixRatio (16 / 9))
-- >
-- >      -- Clear the aspect ratio from the focused window
-- >   ,((modm .|. shiftMask, xK_a), withFocused $ sendMessage . ResetRatio)
--
-- There's one caveat: to keep the usage of the modifier simple, it
-- doesn't remove a window from its cache automatically. Which means
-- that if you close a program window that has some fixed aspect ratios
-- and relaunch it, sometimes it'll still have the fixed aspect ratio.
-- You can try to avoid this by changing they keybinding used to kill
-- the window:
--
-- >  , ((modMask .|. shiftMask, xK_c), withFocused (sendMessage . ResetRatio) >> kill)
--
-- See <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> for more info
-- on customizing the keybindings.
--
-- This layout also comes with a 'ManageHook' 'doFixAspect' to
-- automatically fix the aspect ratio:
--
-- > myManageHook = composeOne [
-- >   title =? "Netflix" <||> className =? "vlc" --> doFixAspect (16 / 9)
-- >   ...
-- > ]
--
-- Check <https://xmonad.org/TUTORIAL.html#final-touches the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on
-- customizing the manage hook.

-- | Similar to 'layoutHintsWithReplacement', but relies on the user to
-- provide the ratio for each window. @aspectRatio (rx, ry) layout@ will
-- adapt the sizes of a layout's windows according to the provided aspect
-- ratio, and position them inside their originally assigned area
-- according to the @rx@ and @ry@ parameters.
-- (0, 0) places the window at the top left, (1, 0) at the top right,
-- (0.5, 0.5) at the center, etc.
fixedAspectRatio
  :: (Double, Double) -> l a -> ModifiedLayout FixedAspectRatio l a
fixedAspectRatio :: forall (l :: * -> *) a.
(Double, Double) -> l a -> ModifiedLayout FixedAspectRatio l a
fixedAspectRatio = FixedAspectRatio a -> l a -> ModifiedLayout FixedAspectRatio l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FixedAspectRatio a -> l a -> ModifiedLayout FixedAspectRatio l a)
-> ((Double, Double) -> FixedAspectRatio a)
-> (Double, Double)
-> l a
-> ModifiedLayout FixedAspectRatio l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
forall a.
Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio Map Window (Ratio Integer)
forall a. Monoid a => a
mempty

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

instance LayoutModifier FixedAspectRatio Window where
  -- | Note: this resembles redoLayout from "XMonad.Layout.LayoutHints".
  -- The only difference is relying on user defined aspect ratios, and
  -- using the 'adj' function defined below instead of 'mkAdjust'
  pureModifier :: FixedAspectRatio Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (FixedAspectRatio Window))
pureModifier (FixedAspectRatio Map Window (Ratio Integer)
ratios (Double, Double)
placement) Rectangle
_ (Just Stack Window
s) [(Window, Rectangle)]
xs =
    ([(Window, Rectangle)]
xs', Maybe (FixedAspectRatio Window)
forall a. Maybe a
Nothing)
   where
    xs' :: [(Window, Rectangle)]
xs' =
      ((Window, Rectangle) -> (Window, Rectangle))
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: (Window, Rectangle)
x@(Window
_, Rectangle
r) -> (Rectangle -> Rectangle)
-> (Window, Rectangle) -> (Window, Rectangle)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Double, Double) -> Rectangle -> Rectangle -> Rectangle
forall r.
RealFrac r =>
(r, r) -> Rectangle -> Rectangle -> Rectangle
placeRectangle (Double, Double)
placement Rectangle
r) ((Window, Rectangle) -> (Window, Rectangle))
-> (Window, Rectangle) -> (Window, Rectangle)
forall a b. (a -> b) -> a -> b
$ (Window, Rectangle) -> (Window, Rectangle)
applyHint (Window, Rectangle)
x) [(Window, Rectangle)]
xs
    applyHint :: (Window, Rectangle) -> (Window, Rectangle)
applyHint (Window
win, r :: Rectangle
r@(Rectangle Position
x Position
y Dimension
w Dimension
h)) =
      let ar :: Maybe (Ratio Integer)
ar       = Window -> Map Window (Ratio Integer) -> Maybe (Ratio Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win Map Window (Ratio Integer)
ratios
          (Dimension
w', Dimension
h') = (Dimension, Dimension)
-> (Ratio Integer -> (Dimension, Dimension))
-> Maybe (Ratio Integer)
-> (Dimension, Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Dimension
w, Dimension
h) ((Dimension, Dimension) -> Ratio Integer -> (Dimension, Dimension)
adj (Dimension
w, Dimension
h)) Maybe (Ratio Integer)
ar
      in  (Window
win, if Stack Window -> Window -> Bool
forall a. Eq a => Stack a -> a -> Bool
isInStack Stack Window
s Window
win then Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w' Dimension
h' else Rectangle
r)

  pureModifier FixedAspectRatio Window
_ Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
xs = ([(Window, Rectangle)]
xs, Maybe (FixedAspectRatio Window)
forall a. Maybe a
Nothing)

  handleMess :: FixedAspectRatio Window
-> SomeMessage -> X (Maybe (FixedAspectRatio Window))
handleMess (FixedAspectRatio Map Window (Ratio Integer)
ratios (Double, Double)
placement) SomeMessage
mess
    | Just DestroyWindowEvent { ev_window :: Event -> Window
ev_window = Window
w } <- SomeMessage -> Maybe Event
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess
    = Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FixedAspectRatio Window)
 -> X (Maybe (FixedAspectRatio Window)))
-> (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
-> FixedAspectRatio Window
-> X (Maybe (FixedAspectRatio Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
forall a. a -> Maybe a
Just (FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window)))
-> FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window))
forall a b. (a -> b) -> a -> b
$ Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Window -> Map Window (Ratio Integer)
deleted Window
w) (Double, Double)
placement
    | Bool
otherwise
    = case SomeMessage -> Maybe ManageAspectRatio
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess of
      Just (FixRatio Ratio Integer
r Window
w) ->
        Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FixedAspectRatio Window)
 -> X (Maybe (FixedAspectRatio Window)))
-> (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
-> FixedAspectRatio Window
-> X (Maybe (FixedAspectRatio Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
forall a. a -> Maybe a
Just (FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window)))
-> FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window))
forall a b. (a -> b) -> a -> b
$ Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Window -> Ratio Integer -> Map Window (Ratio Integer)
inserted Window
w Ratio Integer
r) (Double, Double)
placement
      Just (ResetRatio Window
w) ->
        Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FixedAspectRatio Window)
 -> X (Maybe (FixedAspectRatio Window)))
-> (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
-> FixedAspectRatio Window
-> X (Maybe (FixedAspectRatio Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
forall a. a -> Maybe a
Just (FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window)))
-> FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window))
forall a b. (a -> b) -> a -> b
$ Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Window -> Map Window (Ratio Integer)
deleted Window
w) (Double, Double)
placement
      Just (ToggleRatio Ratio Integer
r Window
w) ->
        Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Maybe (FixedAspectRatio Window)
 -> X (Maybe (FixedAspectRatio Window)))
-> (Maybe (Ratio Integer) -> Maybe (FixedAspectRatio Window))
-> Maybe (Ratio Integer)
-> X (Maybe (FixedAspectRatio Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
forall a. a -> Maybe a
Just
          (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
-> (Maybe (Ratio Integer) -> FixedAspectRatio Window)
-> Maybe (Ratio Integer)
-> Maybe (FixedAspectRatio Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Window (Ratio Integer)
 -> (Double, Double) -> FixedAspectRatio Window)
-> (Double, Double)
-> Map Window (Ratio Integer)
-> FixedAspectRatio Window
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Double, Double)
placement
          (Map Window (Ratio Integer) -> FixedAspectRatio Window)
-> (Maybe (Ratio Integer) -> Map Window (Ratio Integer))
-> Maybe (Ratio Integer)
-> FixedAspectRatio Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Window (Ratio Integer)
-> (Ratio Integer -> Map Window (Ratio Integer))
-> Maybe (Ratio Integer)
-> Map Window (Ratio Integer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Window -> Ratio Integer -> Map Window (Ratio Integer)
inserted Window
w Ratio Integer
r) (Map Window (Ratio Integer)
-> Ratio Integer -> Map Window (Ratio Integer)
forall a b. a -> b -> a
const (Map Window (Ratio Integer)
 -> Ratio Integer -> Map Window (Ratio Integer))
-> Map Window (Ratio Integer)
-> Ratio Integer
-> Map Window (Ratio Integer)
forall a b. (a -> b) -> a -> b
$ Window -> Map Window (Ratio Integer)
deleted Window
w)
          (Maybe (Ratio Integer) -> X (Maybe (FixedAspectRatio Window)))
-> Maybe (Ratio Integer) -> X (Maybe (FixedAspectRatio Window))
forall a b. (a -> b) -> a -> b
$ Window -> Map Window (Ratio Integer) -> Maybe (Ratio Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Map Window (Ratio Integer)
ratios
      Maybe ManageAspectRatio
_ -> Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FixedAspectRatio Window)
forall a. Maybe a
Nothing
   where
    inserted :: Window -> Ratio Integer -> Map Window (Ratio Integer)
inserted Window
w Ratio Integer
r = Window
-> Ratio Integer
-> Map Window (Ratio Integer)
-> Map Window (Ratio Integer)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
w Ratio Integer
r Map Window (Ratio Integer)
ratios
    deleted :: Window -> Map Window (Ratio Integer)
deleted Window
w = Window -> Map Window (Ratio Integer) -> Map Window (Ratio Integer)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Window
w Map Window (Ratio Integer)
ratios

-- | A 'ManageHook' to set the aspect ratio for newly spawned windows
doFixAspect
  :: Rational -- ^ The aspect ratio
  -> ManageHook
doFixAspect :: Ratio Integer -> Query (Endo WindowSet)
doFixAspect Ratio Integer
r = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  Query Window
-> (Window -> Query (Endo WindowSet)) -> Query (Endo WindowSet)
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X () -> Query ()
forall a. X a -> Query a
liftX (ManageAspectRatio -> X ()
forall a. Message a => a -> X ()
sendMessageWithNoRefreshToCurrent (Ratio Integer -> Window -> ManageAspectRatio
FixRatio Ratio Integer
r Window
w)) Query () -> Query (Endo WindowSet) -> Query (Endo WindowSet)
forall a b. Query a -> Query b -> Query b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Query (Endo WindowSet)
forall a. Monoid a => a
mempty

-- | Calculates the new width and height so they respect the
-- aspect ratio.
adj :: (Dimension, Dimension) -> Rational -> (Dimension, Dimension)
adj :: (Dimension, Dimension) -> Ratio Integer -> (Dimension, Dimension)
adj (Dimension
w, Dimension
h) Ratio Integer
ar | Ratio Integer
ar' Ratio Integer -> Ratio Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Ratio Integer
ar  = (Ratio Integer -> Dimension
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer -> Dimension) -> Ratio Integer -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
ar, Dimension
h)
              | Bool
otherwise = (Dimension
w, Ratio Integer -> Dimension
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer -> Dimension) -> Ratio Integer -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Ratio Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Ratio Integer
ar)
  where ar' :: Ratio Integer
ar' = Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h

--- Message handling
data ManageAspectRatio =
    FixRatio Rational Window    -- ^ Set the aspect ratio for the window
  | ResetRatio Window           -- ^ Remove the aspect ratio for the window
  | ToggleRatio Rational Window -- ^ Toggle the reatio
  deriving Typeable

instance Message ManageAspectRatio