From bc1f9daeac09beb20a2c587d259048aea3b03176 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Tue, 12 Apr 2022 00:38:26 -0600
Subject: Break Rotate into it's own file.

---
 src/Rahm/Desktop/Layout/Rotate.hs | 62 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 src/Rahm/Desktop/Layout/Rotate.hs

(limited to 'src/Rahm/Desktop/Layout/Rotate.hs')

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
-- 
cgit