{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards #-}
module XMonad.Layout.FixedAspectRatio
(
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
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
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
doFixAspect
:: Rational
-> 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
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
data ManageAspectRatio =
FixRatio Rational Window
| ResetRatio Window
| ToggleRatio Rational Window
deriving Typeable
instance Message ManageAspectRatio