diff options
Diffstat (limited to '')
| -rw-r--r-- | XMonad/Layout/ZoomRow.hs | 258 |
1 files changed, 258 insertions, 0 deletions
diff --git a/XMonad/Layout/ZoomRow.hs b/XMonad/Layout/ZoomRow.hs new file mode 100644 index 0000000..5d6398c --- /dev/null +++ b/XMonad/Layout/ZoomRow.hs @@ -0,0 +1,258 @@ +{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses + , PatternGuards, DeriveDataTypeable, ExistentialQuantification + , FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ZoomRow +-- Copyright : Quentin Moser <moserq@gmail.com> +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Quentin Moser <quentin.moser@unifr.ch> +-- Stability : unstable +-- Portability : unportable +-- +-- Row layout with individually resizable elements. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.ZoomRow ( -- * Usage + -- $usage + ZoomRow + -- * Creation + , zoomRow + -- * Messages + , ZoomMessage(..) + , zoomIn + , zoomOut + , zoomReset + -- * Use with non-'Eq' elements + -- $noneq + , zoomRowWith + , EQF(..) + , ClassEQ(..) + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import XMonad.Util.Stack +import XMonad.Layout.Decoration (fi) + +import Data.Maybe (fromMaybe) +import Control.Arrow (second) + +-- $usage +-- This module provides a layout which places all windows in a single +-- row; the size occupied by each individual window can be increased +-- and decreased, and a window can be set to use the whole available +-- space whenever it has focus. +-- +-- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@: +-- +-- > import XMonad.Layout.ZoomRow +-- +-- and using 'zoomRow' somewhere in your 'layoutHook', for example: +-- +-- > myLayout = zoomRow ||| Mirror zoomRow +-- +-- To be able to resize windows, you can create keybindings to send +-- the relevant 'ZoomMessage's: +-- +-- > -- Increase the size occupied by the focused window +-- > , ((modMask .|. shifMask, xK_minus), sendMessage zoomIn) +-- > -- Decrease the size occupied by the focused window +-- > , ((modMayk , xK_minus), sendMessage zoomOut) +-- > -- Reset the size occupied by the focused window +-- > , ((modMask , xK_equal), sendMessage zoomReset) +-- > -- (Un)Maximize the focused window +-- > , ((modMask , xK_f ), sendMessage ToggleZoomFull) +-- +-- For more information on editing your layout hook and key bindings, +-- see "XMonad.Doc.Extending". + +-- * Creation functions + +-- | 'ZoomRow' layout for laying out elements which are instances of +-- 'Eq'. Perfect for 'Window's. +zoomRow :: (Eq a, Show a, Read a) => ZoomRow ClassEQ a +zoomRow = ZC ClassEQ emptyZ + +-- $noneq +-- Haskell's 'Eq' class is usually concerned with structural equality, whereas +-- what this layout really wants is for its elements to have a unique identity, +-- even across changes. There are cases (such as, importantly, 'Window's) where +-- the 'Eq' instance for a type actually does that, but if you want to lay +-- out something more exotic than windows and your 'Eq' means something else, +-- you can use the following. + +-- | ZoomRow layout with a custom equality predicate. It should +-- of course satisfy the laws for 'Eq', and you should also make +-- sure that the layout never has to handle two \"equal\" elements +-- at the same time (it won't do any huge damage, but might behave +-- a bit strangely). +zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a) + => f a -> ZoomRow f a +zoomRowWith f = ZC f emptyZ + + +-- * The datatypes + +-- | A layout that arranges its windows in a horizontal row, +-- and allows to change the relative size of each element +-- independently. +data ZoomRow f a = ZC { zoomEq :: f a + -- ^ Function to compare elements for + -- equality, a real Eq instance might + -- not be what you want in some cases + , zoomRatios :: (Zipper (Elt a)) + -- ^ Element specs. The zipper is so we + -- know what the focus is when we handle + -- a message + } + deriving (Show, Read, Eq) + +-- | Class for equivalence relations. Must be transitive, reflexive. +class EQF f a where + eq :: f a -> a -> a -> Bool + +-- | To use the usual '==': +data ClassEQ a = ClassEQ + deriving (Show, Read, Eq) + +instance Eq a => EQF ClassEQ a where + eq _ a b = a == b + +-- | Size specification for an element. +data Elt a = E { elt :: a -- ^ The element + , ratio :: Rational -- ^ Its size ratio + , full :: Bool -- ^ Whether it should occupy all the + -- available space when it has focus. + } + deriving (Show, Read, Eq) + + +-- * Helpers + +getRatio :: Elt a -> (a, Rational) +getRatio (E a r _) = (a,r) + +lookupBy :: (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a) +lookupBy _ _ [] = Nothing +lookupBy f a (E a' r b : _) | f a a' = Just $ E a r b +lookupBy f a (_:es) = lookupBy f a es + +setFocus :: Zipper a -> a -> Zipper a +setFocus Nothing a = Just $ W.Stack a [] [] +setFocus (Just s) a = Just s { W.focus = a } + + +-- * Messages + +-- | The type of messages accepted by a 'ZoomRow' layout +data ZoomMessage = Zoom Rational + -- ^ Multiply the focused window's size factor + -- by the given number. + | ZoomTo Rational + -- ^ Set the focused window's size factor to the + -- given number. + | ZoomFull Bool + -- ^ Set whether the focused window should occupy + -- all available space when it has focus + | ZoomFullToggle + -- ^ Toggle whether the focused window should + -- occupy all available space when it has focus + deriving (Typeable, Show) + +instance Message ZoomMessage + +-- | Increase the size of the focused window. +-- Defined as @Zoom 1.5@ +zoomIn :: ZoomMessage +zoomIn = Zoom 1.5 + +-- | Decrease the size of the focused window. +-- Defined as @Zoom (2/3)@ +zoomOut :: ZoomMessage +zoomOut = Zoom $ 2/3 + +-- | Reset the size of the focused window. +-- Defined as @ZoomTo 1@ +zoomReset :: ZoomMessage +zoomReset = ZoomTo 1 + + +-- * LayoutClass instance + +instance (EQF f a, Show a, Read a, Show (f a), Read (f a)) + => LayoutClass (ZoomRow f) a where + description (ZC _ Nothing) = "ZoomRow" + description (ZC _ (Just s)) = "ZoomRow" ++ if full $ W.focus s + then " (Max)" + else "" + + emptyLayout (ZC _ Nothing) _ = return ([], Nothing) + emptyLayout (ZC f _) _ = return ([], Just $ ZC f Nothing) + + doLayout (ZC f zelts) r@(Rectangle _ _ w _) s + = let elts = W.integrate' zelts + zelts' = mapZ_ (\a -> fromMaybe (E a 1 False) + $ lookupBy (eq f) a elts) $ Just s + elts' = W.integrate' zelts' + + maybeL' = if zelts `noChange` zelts' + then Nothing + else Just $ ZC f zelts' + + total = sum $ map ratio elts' + + widths = map (second ((* fi w) . (/total)) . getRatio) elts' + + in case getFocusZ zelts' of + Just (E a _ True) -> return ([(a, r)], maybeL') + _ -> return (makeRects r widths, maybeL') + + where makeRects :: Rectangle -> [(a, Rational)] -> [(a, Rectangle)] + makeRects r pairs = let as = map fst pairs + widths = map snd pairs + discreteWidths = snd $ foldr discretize (0, []) widths + rectangles = snd $ foldr makeRect (r, []) discreteWidths + in zip as rectangles + + -- | Make a new rectangle by substracting the given width from the available + -- space (from the right, since this is a foldr) + makeRect :: Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle]) + makeRect w (Rectangle x y w0 h, rs) = ( Rectangle x y (w0-w) h + , Rectangle (x+fi w0-fi w) y w h : rs ) + + -- | Round a list of fractions in a way that maintains the total. + -- If you know a better way to do this I'm very interested. + discretize :: Rational -> (Rational, [Dimension]) -> (Rational, [Dimension]) + discretize r (carry, ds) = let (d, carry') = properFraction $ carry+r + in (carry', d:ds) + + noChange z1 z2 = toTags z1 `helper` toTags z2 + where helper [] [] = True + helper (Right a:as) (Right b:bs) = a `sameAs` b && as `helper` bs + helper (Left a:as) (Left b:bs) = a `sameAs` b && as `helper` bs + helper _ _ = False + E a1 r1 b1 `sameAs` E a2 r2 b2 = (eq f a1 a2) && (r1 == r2) && (b1 == b2) + + pureMessage (ZC f zelts) sm | Just (ZoomFull False) <- fromMessage sm + , Just (E a r True) <- getFocusZ zelts + = Just $ ZC f $ setFocus zelts $ E a r False + + pureMessage (ZC f zelts) sm | Just (ZoomFull True) <- fromMessage sm + , Just (E a r False) <- getFocusZ zelts + = Just $ ZC f $ setFocus zelts $ E a r True + + pureMessage (ZC f zelts) sm | Just (E a r b) <- getFocusZ zelts + = case fromMessage sm of + Just (Zoom r') -> Just $ ZC f $ setFocus zelts $ E a (r*r') b + Just (ZoomTo r') -> Just $ ZC f $ setFocus zelts $ E a r' b + Just ZoomFullToggle -> pureMessage (ZC f zelts) + $ SomeMessage $ ZoomFull $ not b + _ -> Nothing + + pureMessage _ _ = Nothing
\ No newline at end of file |