Merge pull request #848 from portnov/master

Add new module: X.L.CircleEx: advanced version of Circle layout

CHANGES.md

@@ -76,6 +76,11 @@
     - Deprecated the entire module, use `XMonad.Actions.WithAll`
       instead.
 
+  * `XMonad.Layout.Circle`:
+
+    - Deprecated the entire module, use the `circle` function from
+      `XMonad.Layout.CircleEx` instead.
+
   * `XMonad.Hooks.EwmhDesktops`
 
     - `_NET_CLIENT_LIST_STACKING` puts windows in the current workspace at the
@@ -135,6 +140,11 @@
       There's both an action to be bound to a key, and hooks that plug into
       `XMonad.Hooks.EwmhDesktops`.
 
+  * `XMonad.Layout.CircleEx`:
+
+    - A new window layout, similar to X.L.Circle, but with more
+      possibilities for customisation.
+
 ### Bug Fixes and Minor Changes
 
   * `XMonad.Layout.Magnifier`

XMonad/Layout/Circle.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -15,15 +16,14 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.Circle (
+module XMonad.Layout.Circle {-# DEPRECATED "Use XMonad.Layout.CircleEx instead" #-}
-                             -- * Usage
+  ( -- * Usage
-                             -- $usage
+    -- $usage
-                             Circle (..)
+    pattern Circle
-                            ) where -- actually it's an ellipse
+  ) where -- actually it's an ellipse
 
-import XMonad.Prelude
+import GHC.Real (Ratio(..))
-import XMonad
+import XMonad.Layout.CircleEx
-import XMonad.StackSet (integrate, peek)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -39,37 +39,6 @@ import XMonad.StackSet (integrate, peek)
 -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
 -- "XMonad.Doc.Extending#Editing_the_layout_hook".
 
-data Circle a = Circle deriving ( Read, Show )
+pattern Circle :: CircleEx a
+pattern Circle = CircleEx 1 (70 :% 99) (2 :% 5) 1 0
 
-instance LayoutClass Circle Window where
-    doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s
-                             return (layout, Nothing)
-
-circleLayout :: Rectangle -> [a] -> [(a, Rectangle)]
-circleLayout _ []     = []
-circleLayout r (w:ws) = master : rest
-    where master = (w, center r)
-          rest   = zip ws $ map (satellite r) [0, pi * 2 / fromIntegral (length ws) ..]
-
-raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)]
-raiseFocus xs = do focused <- withWindowSet (return . peek)
-                   return $ case find ((== focused) . Just . fst) xs of
-                              Just x  -> x : delete x xs
-                              Nothing -> xs
-
-center :: Rectangle -> Rectangle
-center (Rectangle sx sy sw sh) = Rectangle x y w h
-    where s = sqrt 2 :: Double
-          w = round (fromIntegral sw / s)
-          h = round (fromIntegral sh / s)
-          x = sx + fromIntegral (sw - w) `div` 2
-          y = sy + fromIntegral (sh - h) `div` 2
-
-satellite :: Rectangle -> Double -> Rectangle
-satellite (Rectangle sx sy sw sh) a = Rectangle (sx + round (rx + rx * cos a))
-                                                (sy + round (ry + ry * sin a))
-                                                w h
-    where rx = fromIntegral (sw - w) / 2
-          ry = fromIntegral (sh - h) / 2
-          w = sw * 10 `div` 25
-          h = sh * 10 `div` 25

XMonad/Layout/CircleEx.hs

@@ -0,0 +1,189 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.CircleEx
+-- Description :  An elliptical, overlapping layout—extended version.
+-- Copyright   :  (c) Peter De Wachter, Ilya V. Portnov
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Ilya V. Portnov <portnov84@rambler.ru>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Circle is an elliptical, overlapping layout. Original code by Peter De Wachter,
+-- extended by Ilya Porntov.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.CircleEx (
+    -- * Usage
+    -- $usage
+    CircleEx (..), circle, circleEx,
+    CircleExMsg (..)
+  )
+  where
+
+import Data.Ratio
+
+import XMonad
+import XMonad.StackSet (Stack)
+import XMonad.Prelude
+import qualified XMonad.StackSet as W
+
+-- $usage
+--
+-- The layout puts the first N windows (called master) into the center of
+-- screen. All others (called secondary, or stack) are organized in a circle
+-- (well, ellipse). When opening a new secondary window, its size will be
+-- slightly smaller than that of its predecessor (this is configurable). If
+-- the number of master windows is set to zero, all windows will be arranged
+-- in a circle. If there is more than one master window, they will be stacked
+-- in the center on top of each other. The size of each additional master
+-- window will again be slightly smaller than that of the former.
+--
+-- Since a picture says more than a thousand words, you see one
+-- <https://github.com/xmonad/xmonad-contrib/assets/50166980/90ef1273-5201-4380-8b94-9e62d3c98e1c here>.
+--
+-- You can use this module with the following in your @xmonad.hs@:
+--
+-- > import XMonad.Layout.CircleEx
+--
+-- Then edit your @layoutHook@ by adding the 'CircleEx' layout:
+--
+-- > myCircle = circleEx {cDelta = -3*pi/4}
+-- > myLayout = myCircle ||| Full ||| etc..
+-- > main = xmonad def { layoutHook = myLayout }
+--
+-- This layout understands standard messages:
+--
+-- * 'IncMasterN': increase or decrease the number of master windows.
+-- * 'Shrink' and 'Expand': change the size of master windows.
+--
+-- More layout-specific messages are also supported, see 'CircleExMsg' below.
+--
+-- For more detailed instructions on editing the layoutHook see:
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- | The layout data type. It is recommended to not use the 'CircleEx' data
+-- constructor directly, and instead rely on record update syntax; for
+-- example: @circleEx {cMasterRatio = 4%5}@. In this way you can avoid nasty
+-- surprises if one day additional fields are added to @CircleEx@.
+data CircleEx a = CircleEx
+    { cNMaster :: !Int          -- ^ Number of master windows. Default value is 1.
+    , cMasterRatio :: !Rational -- ^ Size of master window in relation to screen size.
+                                --   Default value is @4%5@.
+    , cStackRatio :: !Rational  -- ^ Size of first secondary window in relation to screen size.
+                                --   Default value is @3%5@.
+    , cMultiplier :: !Rational  -- ^ Coefficient used to calculate the sizes of subsequent secondary
+                                --   windows. The size of the next window is calculated as the
+                                --   size of the previous one multiplied by this value.
+                                --   This value is also used to scale master windows, in case
+                                --   there is more than one.
+                                --   Default value is @5%6@. Set this to 1 if you want all secondary
+                                --   windows to have the same size.
+    , cDelta :: !Double         -- ^ Angle of rotation of the whole circle layout. Usual values
+                                --   are from 0 to 2π, although it will work outside
+                                --   this range as well. Default value of 0 means that the first
+                                --   secondary window will be placed at the right side of screen.
+    } deriving (Eq, Show, Read)
+
+-- | Circle layout with default settings:
+--
+-- * Number of master windows is set to 1
+-- * @cMasterRatio@ is set to @70/99@, which is nearly @1/sqrt(2)@
+-- * @cStackRatio@ is set to @2/5@
+-- * @cMultiplier@ is set to 1, which means all secondary windows
+--   will have the same size
+--
+-- This can be used as a drop-in replacement for "XMonad.Layout.Circle".
+circle :: CircleEx a
+circle = CircleEx 1 (70%99) (2%5) 1 0
+
+-- | Another variant of default settings for circle layout:
+--
+-- * Number of master windows is set to 1
+-- * @cMasterRatio@ is set to @4/5@
+-- * @cStackRatio@ is set to @3/5@
+-- * @cMultiplier@ is set to @5/6@
+--
+circleEx :: CircleEx a
+circleEx = CircleEx 1 (4%5) (3%5) (5%6) 0
+
+-- | Specific messages understood by CircleEx layout.
+data CircleExMsg
+  = Rotate !Double            -- ^ Rotate secondary windows by specific angle
+  | IncStackRatio !Rational   -- ^ Increase (or decrease, with negative value) sizes of secondary windows
+  | IncMultiplier !Rational   -- ^ Increase 'cMultiplier'.
+  deriving (Eq, Show, Typeable)
+
+instance Message CircleExMsg
+
+instance LayoutClass CircleEx Window where
+  doLayout :: CircleEx Window -> Rectangle -> Stack Window -> X ([(Window, Rectangle)], Maybe (CircleEx Window))
+  doLayout layout rect stack = do
+    result <- raiseFocus $ circleLayout layout rect $ W.integrate stack
+    return (result, Nothing)
+
+  pureMessage :: CircleEx Window -> SomeMessage -> Maybe (CircleEx Window)
+  pureMessage layout m =
+      msum [changeMasterN <$> fromMessage m,
+            resize <$> fromMessage m,
+            specific <$> fromMessage m]
+    where
+      deltaSize = 11 % 10
+
+      resize :: Resize -> CircleEx a
+      resize Shrink = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout / deltaSize}
+      resize Expand = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout * deltaSize}
+
+      changeMasterN :: IncMasterN -> CircleEx a
+      changeMasterN (IncMasterN d) = layout {cNMaster = max 0 (cNMaster layout + d)}
+
+      specific :: CircleExMsg -> CircleEx a
+      specific (Rotate delta) = layout {cDelta = delta + cDelta layout}
+      specific (IncStackRatio delta) = layout {cStackRatio = max 0.1 $ min 2.0 $ delta + cStackRatio layout}
+      specific (IncMultiplier delta) = layout {cMultiplier = max 0.1 $ min 2.0 $ delta + cMultiplier layout}
+
+circleLayout :: CircleEx a -> Rectangle -> [a] -> [(a, Rectangle)]
+circleLayout _ _ [] = []
+circleLayout (CircleEx {..}) rectangle wins =
+    master (take cNMaster wins) ++ rest (drop cNMaster wins)
+  where
+    master :: [a] -> [(a, Rectangle)]
+    master ws = zip ws $ map (placeCenter cMasterRatio cMultiplier rectangle)
+                           [cNMaster-1, cNMaster-2 .. 0]
+    rest :: [a] -> [(a, Rectangle)]
+    rest ws = zip ws $ zipWith (placeSatellite cStackRatio cMultiplier rectangle)
+                        (map (+ cDelta) [0, pi*2 / fromIntegral (length ws) ..])
+                        [0 ..]
+
+
+raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)]
+raiseFocus wrs = do
+  focused <- withWindowSet (return . W.peek)
+  return $ case find ((== focused) . Just . fst) wrs of
+             Just x  -> x : delete x wrs
+             Nothing -> wrs
+
+placeCenter :: Rational -> Rational -> Rectangle -> Int -> Rectangle
+placeCenter ratio multiplier (Rectangle x y width height) n = Rectangle x' y' width' height'
+  where
+    m = ratio * multiplier ^ n
+    width' = round (m * fromIntegral width)
+    height' = round (m * fromIntegral height)
+    x' = x + fromIntegral (width - width') `div` 2
+    y' = y + fromIntegral (height - height') `div` 2
+
+placeSatellite :: Rational -> Rational -> Rectangle -> Double -> Int -> Rectangle
+placeSatellite ratio multiplier (Rectangle x y width height) alpha n =
+    Rectangle x' y' width' height'
+  where
+    m = ratio * multiplier ^ n
+    x' = x + round (rx + rx * cos alpha)
+    y' = y + round (ry + ry * sin alpha)
+    rx = fromIntegral (width - width') / 2
+    ry = fromIntegral (height - height') / 2
+    width' = round (fromIntegral width * m)
+    height' = round (fromIntegral height * m)

XMonad/Layout/DecorationMadness.hs

@@ -17,7 +17,7 @@ module XMonad.Layout.DecorationMadness
     ( -- * Usage
       -- $usage
 
-      -- * Decorated layouts based on Circle
+      -- * Decorated layouts based on CircleEx
       -- $circle
       circleSimpleDefault
     , circleDefault
@@ -94,7 +94,7 @@ import XMonad.Layout.SimpleDecoration
 import XMonad.Layout.TabBarDecoration
 
 import XMonad.Layout.Accordion
-import XMonad.Layout.Circle
+import XMonad.Layout.CircleEx
 import XMonad.Layout.WindowArranger
 import XMonad.Layout.SimpleFloat
 
@@ -132,39 +132,39 @@ import XMonad.Layout.SimpleFloat
 -- "XMonad.Util.Themes"
 
 -- $circle
--- Here you will find 'Circle' based decorated layouts.
+-- Here you will find 'CircleEx' based decorated layouts.
 
--- | A 'Circle' layout with the xmonad default decoration, default
+-- | A 'CircleEx' layout with the xmonad default decoration, default
 -- theme and default shrinker.
 --
 -- Here you can find a screen shot:
 --
 -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefault.png>
-circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window
+circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) CircleEx Window
-circleSimpleDefault = decoration shrinkText def DefaultDecoration Circle
+circleSimpleDefault = decoration shrinkText def DefaultDecoration circle
 
 -- | Similar to 'circleSimpleDefault' but with the possibility of
 -- setting a custom shrinker and a custom theme.
 circleDefault :: Shrinker s => s -> Theme
-              -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window
+              -> ModifiedLayout (Decoration DefaultDecoration s) CircleEx Window
-circleDefault s t = decoration s t DefaultDecoration Circle
+circleDefault s t = decoration s t DefaultDecoration circle
 
--- | A 'Circle' layout with the xmonad simple decoration, default
+-- | A 'CircleEx' layout with the xmonad simple decoration, default
 -- theme and default shrinker.
 --
 -- Here you can find a screen shot:
 --
 -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDeco.png>
-circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window
+circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) CircleEx Window
-circleSimpleDeco = decoration shrinkText def (Simple True) Circle
+circleSimpleDeco = decoration shrinkText def (Simple True) circle
 
 -- | Similar to 'circleSimpleDece' but with the possibility of
 -- setting a custom shrinker and a custom theme.
 circleDeco :: Shrinker s => s -> Theme
-           -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window
+           -> ModifiedLayout (Decoration SimpleDecoration s) CircleEx Window
-circleDeco s t = decoration s t (Simple True) Circle
+circleDeco s t = decoration s t (Simple True) circle
 
--- | A 'Circle' layout with the xmonad default decoration, default
+-- | A 'CircleEx' layout with the xmonad default decoration, default
 -- theme and default shrinker, but with the possibility of moving
 -- windows with the mouse, and resize\/move them with the keyboard.
 --
@@ -172,17 +172,17 @@ circleDeco s t = decoration s t (Simple True) Circle
 --
 -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefaultResizable.png>
 circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
-                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window
-circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Circle)
+circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange circle)
 
 -- | Similar to 'circleSimpleDefaultResizable' but with the
 -- possibility of setting a custom shrinker and a custom theme.
 circleDefaultResizable :: Shrinker s => s -> Theme
                        -> ModifiedLayout (Decoration DefaultDecoration s)
-                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window
-circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle)
+circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange circle)
 
--- | A 'Circle' layout with the xmonad simple decoration, default
+-- | A 'CircleEx' layout with the xmonad simple decoration, default
 -- theme and default shrinker, but with the possibility of moving
 -- windows with the mouse, and resize\/move them with the keyboard.
 --
@@ -190,45 +190,45 @@ circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ win
 --
 -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDecoResizable.png>
 circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
-                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window
-circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Circle)
+circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange circle)
 
 -- | Similar to 'circleSimpleDecoResizable' but with the
 -- possibility of setting a custom shrinker and a custom theme.
 circleDecoResizable :: Shrinker s => s -> Theme
                     -> ModifiedLayout (Decoration SimpleDecoration s)
-                       (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+                       (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window
-circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle)
+circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange circle)
 
--- | A 'Circle' layout with the xmonad DwmStyle decoration, default
+-- | A 'CircleEx' layout with the xmonad DwmStyle decoration, default
 -- theme and default shrinker.
 --
 -- Here you can find a screen shot:
 --
 -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDwmStyle.png>
-circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window
+circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) CircleEx Window
-circleSimpleDwmStyle = decoration shrinkText def Dwm Circle
+circleSimpleDwmStyle = decoration shrinkText def Dwm circle
 
 -- | Similar to 'circleSimpleDwmStyle' but with the
 -- possibility of setting a custom shrinker and a custom theme.
 circleDwmStyle :: Shrinker s => s -> Theme
-               -> ModifiedLayout (Decoration DwmStyle s) Circle Window
+               -> ModifiedLayout (Decoration DwmStyle s) CircleEx Window
-circleDwmStyle s t = decoration s t Dwm Circle
+circleDwmStyle s t = decoration s t Dwm circle
 
--- | A 'Circle' layout with the xmonad tabbed decoration, default
+-- | A 'CircleEx' layout with the xmonad tabbed decoration, default
 -- theme and default shrinker.
 --
 -- Here you can find a screen shot:
 --
 -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleTabbed.png>
-circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window
+circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen CircleEx) Window
-circleSimpleTabbed = simpleTabBar Circle
+circleSimpleTabbed = simpleTabBar circle
 
 -- | Similar to 'circleSimpleTabbed' but with the
 -- possibility of setting a custom shrinker and a custom theme.
 circleTabbed :: Shrinker s => s -> Theme
-             -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window
+             -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen CircleEx) Window
-circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle)
+circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) circle)
 
 
 -- $accordion

XMonad/Layout/SubLayouts.hs

@@ -47,8 +47,6 @@ module XMonad.Layout.SubLayouts (
     )
     where
 
-import XMonad.Layout.Circle () -- so haddock can find the link
-
 import XMonad.Layout.Decoration(Decoration, DefaultShrinker)
 import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout,
                                     redoLayout),
@@ -184,11 +182,11 @@ import qualified Data.Set as S
 --  [@outerLayout@] The layout that determines the rectangles given to each
 --  group.
 --
---  Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed
+--  Ex. The second group is 'Tall', the third is 'XMonad.Layout.CircleEx.circle',
---  with:
+--  all others are tabbed with:
 --
 --  > myLayout = addTabs shrinkText def
---  >          $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle)
+--  >          $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| circle)
 --  >          $ Tall 1 0.2 0.5 ||| Full
 subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a
 subLayout nextLayout sl = ModifiedLayout (Sublayout (I []) (nextLayout,sl) [])

xmonad-contrib.cabal

@@ -232,6 +232,7 @@ library
                         XMonad.Layout.CenteredIfSingle
                         XMonad.Layout.CenteredMaster
                         XMonad.Layout.Circle
+                        XMonad.Layout.CircleEx
                         XMonad.Layout.Column
                         XMonad.Layout.Combo
                         XMonad.Layout.ComboP