{-# 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\/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 "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 "XMonad.Doc.Extending#Editing_key_bindings" 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 "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 :: (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 Rational -> (Double, Double) -> FixedAspectRatio a
forall a.
Map Window Rational -> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio Map Window Rational
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
readListPrec :: ReadPrec [FixedAspectRatio a]
$creadListPrec :: forall a. ReadPrec [FixedAspectRatio a]
readPrec :: ReadPrec (FixedAspectRatio a)
$creadPrec :: forall a. ReadPrec (FixedAspectRatio a)
readList :: ReadS [FixedAspectRatio a]
$creadList :: forall a. ReadS [FixedAspectRatio a]
readsPrec :: Int -> ReadS (FixedAspectRatio a)
$creadsPrec :: forall a. Int -> ReadS (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
showList :: [FixedAspectRatio a] -> ShowS
$cshowList :: forall a. [FixedAspectRatio a] -> ShowS
show :: FixedAspectRatio a -> String
$cshow :: forall a. FixedAspectRatio a -> String
showsPrec :: Int -> FixedAspectRatio a -> ShowS
$cshowsPrec :: forall a. Int -> 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 Rational
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 (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 Rational
ar       = Window -> Map Window Rational -> Maybe Rational
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win Map Window Rational
ratios
          (Dimension
w', Dimension
h') = (Dimension, Dimension)
-> (Rational -> (Dimension, Dimension))
-> Maybe Rational
-> (Dimension, Dimension)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Dimension
w, Dimension
h) ((Dimension, Dimension) -> Rational -> (Dimension, Dimension)
adj (Dimension
w, Dimension
h)) Maybe Rational
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 Rational
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 (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 Rational -> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window Rational -> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Window -> Map Window Rational
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 Rational
r Window
w) ->
        Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
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 Rational -> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window Rational -> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Window -> Rational -> Map Window Rational
inserted Window
w Rational
r) (Double, Double)
placement
      Just (ResetRatio Window
w) ->
        Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
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 Rational -> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window Rational -> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Window -> Map Window Rational
deleted Window
w) (Double, Double)
placement
      Just (ToggleRatio Rational
r Window
w) ->
        Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Maybe (FixedAspectRatio Window)
 -> X (Maybe (FixedAspectRatio Window)))
-> (Maybe Rational -> Maybe (FixedAspectRatio Window))
-> Maybe Rational
-> 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 Rational -> FixedAspectRatio Window)
-> Maybe Rational
-> Maybe (FixedAspectRatio Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Window Rational
 -> (Double, Double) -> FixedAspectRatio Window)
-> (Double, Double)
-> Map Window Rational
-> FixedAspectRatio Window
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map Window Rational -> (Double, Double) -> FixedAspectRatio Window
forall a.
Map Window Rational -> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Double, Double)
placement
          (Map Window Rational -> FixedAspectRatio Window)
-> (Maybe Rational -> Map Window Rational)
-> Maybe Rational
-> FixedAspectRatio Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Window Rational
-> (Rational -> Map Window Rational)
-> Maybe Rational
-> Map Window Rational
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Window -> Rational -> Map Window Rational
inserted Window
w Rational
r) (Map Window Rational -> Rational -> Map Window Rational
forall a b. a -> b -> a
const (Map Window Rational -> Rational -> Map Window Rational)
-> Map Window Rational -> Rational -> Map Window Rational
forall a b. (a -> b) -> a -> b
$ Window -> Map Window Rational
deleted Window
w)
          (Maybe Rational -> X (Maybe (FixedAspectRatio Window)))
-> Maybe Rational -> X (Maybe (FixedAspectRatio Window))
forall a b. (a -> b) -> a -> b
$ Window -> Map Window Rational -> Maybe Rational
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Map Window Rational
ratios
      Maybe ManageAspectRatio
_ -> Maybe (FixedAspectRatio Window)
-> X (Maybe (FixedAspectRatio Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FixedAspectRatio Window)
forall a. Maybe a
Nothing
   where
    inserted :: Window -> Rational -> Map Window Rational
inserted Window
w Rational
r = Window -> Rational -> Map Window Rational -> Map Window Rational
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
w Rational
r Map Window Rational
ratios
    deleted :: Window -> Map Window Rational
deleted Window
w = Window -> Map Window Rational -> Map Window Rational
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Window
w Map Window Rational
ratios

-- | A 'ManageHook' to set the aspect ratio for newly spawned windows
doFixAspect
  :: Rational -- ^ The aspect ratio
  -> ManageHook
doFixAspect :: Rational -> ManageHook
doFixAspect Rational
r = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  Query Window -> (Window -> ManageHook) -> ManageHook
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 (Rational -> Window -> ManageAspectRatio
FixRatio Rational
r Window
w)) Query () -> ManageHook -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ManageHook
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) -> Rational -> (Dimension, Dimension)
adj (Dimension
w, Dimension
h) Rational
ar | Rational
ar' Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
ar  = (Rational -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
ar, Dimension
h)
              | Bool
otherwise = (Dimension
w, Rational -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
ar)
  where ar' :: Rational
ar' = Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Integer -> Integer -> Rational
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