Break Rotate into it's own file.

1 files changed, 62 insertions, 0 deletions

diff --git a/src/Rahm/Desktop/Layout/Rotate.hs b/src/Rahm/Desktop/Layout/Rotate.hs
new file mode 100644
index 0000000..8a8583a
--- /dev/null
+++ b/src/Rahm/Desktop/Layout/Rotate.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+-- Layout modifier which optionally rotates the underlying layout. This actually
+-- uses the mirrorRect, so it's not strictly rotating, but when combined with
+-- flipping it works.
+module Rahm.Desktop.Layout.Rotate (
+  rotateable,
+  rotateLayout,
+  Rotate) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import Data.Default (Default(..))
+import Control.Arrow (second)
+
+-- Just a wrapper over a Bool.
+newtype Rotate a = Rotate Bool
+  deriving (Read, Show, Eq, Ord)
+
+-- Returns a layout that can be rotated.
+rotateable :: l a -> ModifiedLayout Rotate l a
+rotateable = ModifiedLayout def
+
+-- Message to rotate the layout.
+rotateLayout :: RotateMessage
+rotateLayout = RotateMessage $ \(Rotate n) -> Rotate (not n)
+
+-- Default instance just defaults to false..
+instance Default (Rotate a) where
+  def = Rotate False
+
+-- Rotate message is a wrapper over a function to modify a Rotate instance.
+data RotateMessage where
+  RotateMessage :: (forall k (a :: k). Rotate a -> Rotate a) -> RotateMessage
+  deriving (Message)
+
+instance (Eq a) => LayoutModifier Rotate a where
+  pureModifier (Rotate rotate) (Rectangle x' y' sw sh) _ returned =
+    if rotate
+      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
+      else (returned, Nothing)
+    where
+      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
+      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
+
+      scaleRect (Rectangle x y w h) =
+        Rectangle (x * fi sw `div` fi sh)
+                  (y * fi sh `div` fi sw)
+                  (w * sw `div` sh)
+                  (h * sh `div` sw)
+
+      fi = fromIntegral
+
+
+  pureMess r (fromMessage -> Just (RotateMessage f)) = Just (f r)
+  pureMess _ _ = Nothing
+
+  modifyDescription (Rotate rot) underlying =
+    let descr = description underlying in
+      if rot
+        then descr ++ " Rotated"
+        else descr