diff options
Diffstat (limited to 'MetaTile/Layout')
| -rw-r--r-- | MetaTile/Layout/Floating.hs | 105 | ||||
| -rw-r--r-- | MetaTile/Layout/LayoutModifier.hs | 2 |
2 files changed, 106 insertions, 1 deletions
diff --git a/MetaTile/Layout/Floating.hs b/MetaTile/Layout/Floating.hs new file mode 100644 index 0000000..48abc7f --- /dev/null +++ b/MetaTile/Layout/Floating.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable #-} + +module MetaTile.Layout.Floating ( + Floating, floating, + float, sink, mouseMoveWindow, mouseResizeWindow + ) where + +import Prelude hiding (Floating) + +import MetaTile.Core +import MetaTile.Layout.LayoutModifier +import MetaTile.Operations +import qualified MetaTile.StackSet as W +import qualified MetaTile.Util.ExtensibleState as XS + +import Control.Arrow ((&&&), first) +import Control.Monad.Reader +import Control.Monad.State +import Data.Functor +import qualified Data.Map as M +import Data.Maybe +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + + +data FloatingStorage = FloatingStorage { + floatingWindows :: M.Map Window Rectangle + } deriving (Show, Read, Typeable) + +instance ExtensionClass FloatingStorage where + initialValue = FloatingStorage M.empty + extensionType = PersistentExtension + + +data Floating a = Floating deriving (Show, Read) + +instance LayoutModifier Floating Window where + modifyLayout _ (w@W.Workspace { W.stack = stack }) r = do + bw <- asks (defaultBorderWidth . config) + ws <- gets windowset + FloatingStorage { floatingWindows = fw } <- XS.get + let fw' = M.filterWithKey (\k _ -> k `W.member` ws) fw + tiled = stack >>= W.filter (`M.notMember` fw') + fwLayout = [(a, ar, bw) | (a, ar) <- catMaybes . map (maybeSecond . (id &&& flip M.lookup fw')) $ W.integrate' stack] + XS.put $ FloatingStorage fw' + first (fwLayout ++) <$> runBorderLayout (w { W.stack = tiled }) r + where + maybeSecond :: (a, Maybe b) -> Maybe (a, b) + maybeSecond (a, Just b) = Just (a, b) + maybeSecond (_, Nothing) = Nothing + +floating :: l Window -> ModifiedLayout Floating l Window +floating = ModifiedLayout Floating + + +------------------------------------------------------------------------ +-- | Floating layer support + +-- | Given a window, find the screen it is located on, and compute +-- the geometry of that window wrt. that screen. +floatLocation :: Window -> X (ScreenId, Rectangle) +floatLocation w = withDisplay $ \d -> do + ws <- gets windowset + frame <- getsWindowState wsFrame w + wa <- io $ getWindowAttributes d frame + sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) + let sr = screenRect . W.screenDetail $ sc + rr = Rectangle ((fi $ wa_x wa) - (fi $ rect_x sr)) ((fi $ wa_y wa) - (fi $ rect_y sr)) (fi $ wa_width wa) (fi $ wa_height wa) + return (W.screen sc, rr) + where fi x = fromIntegral x + +-- | Make a tiled window floating, using its suggested rectangle +float :: Window -> X () +float w = do + (_, r) <- floatLocation w + XS.modify $ \(FloatingStorage fw) -> FloatingStorage (M.insert w r fw) + refresh + +-- | Make a tiled window floating, using its suggested rectangle +sink :: Window -> X () +sink w = do + XS.modify $ \(FloatingStorage fw) -> FloatingStorage (M.delete w fw) + refresh + + +-- | XXX comment me +mouseMoveWindow :: Window -> X () +mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do + frame <- getsWindowState wsFrame w + io $ raiseWindow d frame + wa <- io $ getWindowAttributes d frame + (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d frame + let ox = fromIntegral ox' + oy = fromIntegral oy' + mouseDrag (\ex ey -> (io $ moveWindow d frame (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))) >> reveal w) (float w) + +-- | XXX comment me +mouseResizeWindow :: Window -> X () +mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do + frame <- getsWindowState wsFrame w + io $ raiseWindow d frame + wa <- io $ getWindowAttributes d frame + sh <- io $ getWMNormalHints d w + io $ warpPointer d none frame 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) + mouseDrag (\ex ey -> (io $ resizeWindow d frame `uncurry` applySizeHintsContents sh (ex - fromIntegral (wa_x wa), ey - fromIntegral (wa_y wa))) >> reveal w) (float w) diff --git a/MetaTile/Layout/LayoutModifier.hs b/MetaTile/Layout/LayoutModifier.hs index 5d97467..7b66586 100644 --- a/MetaTile/Layout/LayoutModifier.hs +++ b/MetaTile/Layout/LayoutModifier.hs @@ -31,7 +31,7 @@ module MetaTile.Layout.LayoutModifier ( import Control.Monad -import MetaTile +import MetaTile.Core import MetaTile.StackSet ( Stack, Workspace (..) ) -- $usage |