xmonad-bluetilebranch-0.8.1: XMonad/PositionStore.hs

----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.PositionStore
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-----------------------------------------------------------------------------

module XMonad.PositionStore (
        PositionStore,
        posStoreInsert,
        posStoreMove,
        posStoreQuery,
        posStoreRemove
    ) where

import Graphics.X11.Xlib

-- Store window positions relative to the upper left screen edge
-- and windows sizes as well as positions as fractions of the screen size.
-- This way windows can be easily relocated and scaled when switching screens.

type PositionStore a = [(a, PosStoreRectangle)]
data PosStoreRectangle = PSRectangle Double Double Double Double

posStoreInsert :: (Eq a) => PositionStore a -> a -> Rectangle -> Rectangle -> PositionStore a
posStoreInsert posStore w (Rectangle x y wh ht) (Rectangle srX srY srWh srHt) =
    let offsetX = x - srX
        offsetY = y - srY
    in posStoreInsert' posStore w (PSRectangle (fromIntegral offsetX / fromIntegral srWh)
                                               (fromIntegral offsetY / fromIntegral srHt)
                                               (fromIntegral wh / fromIntegral srWh)
                                               (fromIntegral ht / fromIntegral srHt))

posStoreInsert' :: (Eq a) => PositionStore a -> a -> PosStoreRectangle -> PositionStore a
posStoreInsert' posStore w psRect = (w, psRect) : (posStoreRemove posStore w)

posStoreRemove :: (Eq a) => PositionStore a -> a -> PositionStore a
posStoreRemove posStore w = filter (\(w', _) -> w /= w') posStore

posStoreQuery :: (Eq a) => PositionStore a -> a -> Rectangle -> Maybe Rectangle
posStoreQuery posStore w (Rectangle srX srY srWh srHt) = do
    (PSRectangle x y wh ht) <- lookup w posStore
    let realWh = fromIntegral srWh * wh
        realHt = fromIntegral srHt * ht
        realOffsetX = fromIntegral srWh * x
        realOffsetY = fromIntegral srHt * y
    return (Rectangle (srX + round realOffsetX) (srY + round realOffsetY)
                        (round realWh) (round realHt))

posStoreMove :: (Eq a) => PositionStore a -> a -> Position -> Position -> Rectangle -> Rectangle -> PositionStore a
posStoreMove posStore w x y oldSr newSr =
    case (posStoreQuery posStore w oldSr) of
        Nothing -> posStore     -- not in store, can't move -> do nothing
        Just (Rectangle _ _ wh ht) -> posStoreInsert posStore w (Rectangle x y wh ht) newSr