From 9668ec077097e283435937e997edd99dbc0cfa17 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 00:38:26 -0600 Subject: Break Rotate into it's own file. --- src/Rahm/Desktop/Layout/Layout.hs | 43 ++------------------------- src/Rahm/Desktop/Layout/Rotate.hs | 62 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 40 deletions(-) create mode 100644 src/Rahm/Desktop/Layout/Rotate.hs (limited to 'src') diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout/Layout.hs index a871aa6..88143cd 100644 --- a/src/Rahm/Desktop/Layout/Layout.hs +++ b/src/Rahm/Desktop/Layout/Layout.hs @@ -29,10 +29,13 @@ import Rahm.Desktop.Windows import Rahm.Desktop.Layout.ReinterpretMessage import Rahm.Desktop.Layout.Pop import Rahm.Desktop.Layout.Flip +import Rahm.Desktop.Layout.Rotate import qualified Data.Map as M import qualified XMonad.StackSet as W +mods = reinterpretResize . poppable . flippable . rotateable + myLayout = fullscreenFull $ avoidStruts $ @@ -88,12 +91,6 @@ reinterpretIncMaster :: l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a reinterpretIncMaster = ModifiedLayout ReinterpretMessage -mods = - reinterpretResize . - poppable . - flippable . - ModifiedLayout (Rotateable False) - data ModifyDescription m l a = ModifyDescription m (l a) deriving (Show, Read) @@ -138,37 +135,3 @@ instance DescriptionModifier TallDescriptionModifier Tall where instance DescriptionModifier ThreeColDescMod ThreeCol where newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")" newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")" - -newtype Rotateable a = Rotateable Bool -- True if rotated - deriving (Show, Read) - -data DoRotate = DoRotate deriving (Typeable) - -instance Message DoRotate where - -instance (Eq a) => LayoutModifier Rotateable a where - pureModifier (Rotateable 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 (Rotateable rot) mess = - fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess) - - modifyDescription (Rotateable rot) underlying = - let descr = description underlying in - if rot - then descr ++ " Rotated" - else descr 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