diff options
| -rw-r--r-- | src/Internal/CornerLayout.hs | 58 | ||||
| -rw-r--r-- | src/Internal/Keys.hs | 2 | ||||
| -rw-r--r-- | src/Internal/Layout.hs | 58 |
3 files changed, 105 insertions, 13 deletions
diff --git a/src/Internal/CornerLayout.hs b/src/Internal/CornerLayout.hs new file mode 100644 index 0000000..10fbe5b --- /dev/null +++ b/src/Internal/CornerLayout.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} +-- Creates a layout, the "corner layout" that keeps the master window in the +-- corner and the other windows go around it. +module Internal.CornerLayout where + +import Data.Typeable (Typeable) +import XMonad (LayoutClass(..), Rectangle(..), Resize(..), fromMessage) +import qualified XMonad.StackSet as S + +data Corner a = Corner Rational Rational + deriving (Show, Typeable, Read) + +instance LayoutClass Corner a where + pureLayout (Corner frac _) screen@(Rectangle x y w h) ss = + let w' = floor $ fromIntegral w * frac + h' = floor $ fromIntegral h * frac + corner = Rectangle 0 0 w' h' + vertRect = Rectangle (fromIntegral w') 0 (w - w') h + horizRect = Rectangle 0 (fromIntegral h') w' (h - h') + ws = S.integrate ss + + vn = (length ws - 1) `div` 2 + hn = (length ws - 1) - vn + in + case ws of + [a] -> [(a, screen)] + [a, b] -> [ + (a, Rectangle x y w' h), + (b, Rectangle (x + fromIntegral w') y (w - w') h)] + _ -> + zip ws $ map ( + \(Rectangle x' y' w h) -> Rectangle (x + x') (y + y') w h) $ + corner : + (splitVert vertRect vn) ++ + (splitHoriz horizRect hn) + + pureMessage (Corner frac delta) m = fmap resize (fromMessage m) + where + resize Shrink = Corner (frac - delta) delta + resize Expand = Corner (frac + delta) delta + +splitVert :: Rectangle -> Int -> [Rectangle] +splitVert (Rectangle x y w h) i' = + map + (\i -> Rectangle x (y + fromIntegral (step * i)) w step) + [0 .. i - 1] + where + i = fromIntegral i' + step = h `div` i + +splitHoriz :: Rectangle -> Int -> [Rectangle] +splitHoriz (Rectangle x y w h) i' = + map + (\i -> Rectangle (x + fromIntegral (step * i)) y step h) + [0 .. i - 1] + where + step = w `div` i + i = fromIntegral i' diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index bc27750..d02e1f4 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -90,7 +90,7 @@ newKeys markContext = , ((modm , xK_Return), windows W.swapMaster) , ((modm, xK_j), sendMessage Shrink) , ((modm, xK_k), sendMessage Expand) - , ((modm .|. shiftMask, xK_r), (void $ spawn "gmrun")) + , ((modm .|. shiftMask, xK_r), sendMessage DoRotate) , ((modm .|. mod1Mask, xK_l), (void $ spawn "xsecurelock")) , ((modm .|. mod1Mask, xK_s), (void $ spawn "sudo systemctl suspend && xsecurelock")) , ((modm .|. shiftMask, xK_c), kill) diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs index cb8c19b..632e912 100644 --- a/src/Internal/Layout.hs +++ b/src/Internal/Layout.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module Internal.Layout where +import Internal.CornerLayout (Corner(..)) import Control.Arrow (second) import XMonad.Hooks.ManageDocks import XMonad.Layout.Circle @@ -24,18 +25,20 @@ import qualified XMonad.StackSet as W myLayout = avoidStruts $ - ModifiedLayout (Zoomable False 0.05 0.05) $ - ModifiedLayout (Flippable False) $ - ModifiedLayout (HFlippable False) $ - spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ - spiral (6/7) ||| - ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) ||| - ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) ||| - Full ||| - Grid ||| - Dishes 2 (1/6) ||| - (MosaicAlt M.empty :: MosaicAlt Window) ||| - (D.Dwindle D.R D.CW 1.5 1.1) + spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ + ModifiedLayout (Zoomable False 0.05 0.05) $ + ModifiedLayout (Flippable False) $ + ModifiedLayout (HFlippable False) $ + ModifiedLayout (Rotateable False) $ + spiral (6/7) ||| + (Corner (3/4) (3/100) :: Corner Window) ||| + ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2)) ||| + ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2)) ||| + Full ||| + Grid ||| + Dishes 2 (1/6) ||| + (MosaicAlt M.empty :: MosaicAlt Window) ||| + (D.Dwindle D.R D.CW 1.5 1.1) data ModifyDescription m l a = ModifyDescription m (l a) deriving (Show, Read) @@ -90,10 +93,15 @@ data Flippable a = Flippable Bool -- True if flipped data HFlippable a = HFlippable Bool -- True if flipped deriving (Show, Read) +data Rotateable a = Rotateable Bool -- True if rotated + deriving (Show, Read) + data FlipLayout = FlipLayout deriving (Typeable) data HFlipLayout = HFlipLayout deriving (Typeable) +data DoRotate = DoRotate deriving (Typeable) + data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window. deriving (Show, Read) @@ -111,6 +119,32 @@ instance Message HFlipLayout where instance Message ZoomModifier where +instance Message DoRotate where + +instance (Eq a) => LayoutModifier Rotateable a where + pureModifier (Rotateable rotate) (Rectangle _ _ sw sh) _ returned = + if rotate + then (map (second (scaleRect . mirrorRect)) returned, Nothing) + else (returned, Nothing) + where + 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 + instance (Eq a) => LayoutModifier Flippable a where pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned = if flip |