{-# 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 = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio forall a. Monoid a => a
mempty

data FixedAspectRatio a = FixedAspectRatio (M.Map Window Rational)
                                           (Double, Double)
  deriving (ReadPrec [FixedAspectRatio a]
ReadPrec (FixedAspectRatio a)
ReadS [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
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 (Ratio Integer)
ratios (Double, Double)
placement) Rectangle
_ (Just Stack Window
s) [(Window, Rectangle)]
xs =
    ([(Window, Rectangle)]
xs', forall a. Maybe a
Nothing)
   where
    xs' :: [(Window, Rectangle)]
xs' =
      forall a b. (a -> b) -> [a] -> [b]
map (\x :: (Window, Rectangle)
x@(Window
_, Rectangle
r) -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall r.
RealFrac r =>
(r, r) -> Rectangle -> Rectangle -> Rectangle
placeRectangle (Double, Double)
placement Rectangle
r) 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       = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win Map Window (Ratio Integer)
ratios
          (Dimension
w', Dimension
h') = 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 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, 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 } <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess
    = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess of
      Just (FixRatio Ratio Integer
r Window
w) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a.
Map Window (Ratio Integer)
-> (Double, Double) -> FixedAspectRatio a
FixedAspectRatio (Double, Double)
placement
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Window -> Ratio Integer -> Map Window (Ratio Integer)
inserted Window
w Ratio Integer
r) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Window -> Map Window (Ratio Integer)
deleted Window
w)
          forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Map Window (Ratio Integer)
ratios
      Maybe ManageAspectRatio
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
   where
    inserted :: Window -> Ratio Integer -> Map Window (Ratio Integer)
inserted Window
w Ratio Integer
r = 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 = 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 = forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. X a -> Query a
liftX (forall a. Message a => a -> X ()
sendMessageWithNoRefreshToCurrent (Ratio Integer -> Window -> ManageAspectRatio
FixRatio Ratio Integer
r Window
w)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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' forall a. Ord a => a -> a -> Bool
> Ratio Integer
ar  = (forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h forall a. Num a => a -> a -> a
* Ratio Integer
ar, Dimension
h)
              | Bool
otherwise = (Dimension
w, forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Fractional a => a -> a -> a
/ Ratio Integer
ar)
  where ar' :: Ratio Integer
ar' = forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Integral a => a -> a -> Ratio a
% 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