----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.PositionStore
-- Description :  A utility module to store information about position and size of a window.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- A utility module to store information about position and size of a window.
-- See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this.
--
-----------------------------------------------------------------------------

module XMonad.Util.PositionStore (
        getPosStore,
        modifyPosStore,

        posStoreInsert,
        posStoreMove,
        posStoreQuery,
        posStoreRemove,
        PositionStore,
    ) where

import XMonad
import qualified XMonad.Util.ExtensibleState as XS
import qualified Data.Map as M

-- 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.

newtype PositionStore = PS (M.Map Window PosStoreRectangle)
                            deriving (ReadPrec [PositionStore]
ReadPrec PositionStore
Int -> ReadS PositionStore
ReadS [PositionStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PositionStore]
$creadListPrec :: ReadPrec [PositionStore]
readPrec :: ReadPrec PositionStore
$creadPrec :: ReadPrec PositionStore
readList :: ReadS [PositionStore]
$creadList :: ReadS [PositionStore]
readsPrec :: Int -> ReadS PositionStore
$creadsPrec :: Int -> ReadS PositionStore
Read,Int -> PositionStore -> ShowS
[PositionStore] -> ShowS
PositionStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionStore] -> ShowS
$cshowList :: [PositionStore] -> ShowS
show :: PositionStore -> String
$cshow :: PositionStore -> String
showsPrec :: Int -> PositionStore -> ShowS
$cshowsPrec :: Int -> PositionStore -> ShowS
Show)
data PosStoreRectangle = PSRectangle Double Double Double Double
                            deriving (ReadPrec [PosStoreRectangle]
ReadPrec PosStoreRectangle
Int -> ReadS PosStoreRectangle
ReadS [PosStoreRectangle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PosStoreRectangle]
$creadListPrec :: ReadPrec [PosStoreRectangle]
readPrec :: ReadPrec PosStoreRectangle
$creadPrec :: ReadPrec PosStoreRectangle
readList :: ReadS [PosStoreRectangle]
$creadList :: ReadS [PosStoreRectangle]
readsPrec :: Int -> ReadS PosStoreRectangle
$creadsPrec :: Int -> ReadS PosStoreRectangle
Read,Int -> PosStoreRectangle -> ShowS
[PosStoreRectangle] -> ShowS
PosStoreRectangle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PosStoreRectangle] -> ShowS
$cshowList :: [PosStoreRectangle] -> ShowS
show :: PosStoreRectangle -> String
$cshow :: PosStoreRectangle -> String
showsPrec :: Int -> PosStoreRectangle -> ShowS
$cshowsPrec :: Int -> PosStoreRectangle -> ShowS
Show)

instance ExtensionClass PositionStore where
  initialValue :: PositionStore
initialValue = Map Window PosStoreRectangle -> PositionStore
PS forall k a. Map k a
M.empty
  extensionType :: PositionStore -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

getPosStore :: X PositionStore
getPosStore :: X PositionStore
getPosStore = forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get

modifyPosStore :: (PositionStore -> PositionStore) -> X ()
modifyPosStore :: (PositionStore -> PositionStore) -> X ()
modifyPosStore = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify

posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
posStoreInsert (PS Map Window PosStoreRectangle
posStoreMap) Window
w (Rectangle Position
x Position
y Dimension
wh Dimension
ht) (Rectangle Position
srX Position
srY Dimension
srWh Dimension
srHt) =
    let offsetX :: Position
offsetX = Position
x forall a. Num a => a -> a -> a
- Position
srX
        offsetY :: Position
offsetY = Position
y forall a. Num a => a -> a -> a
- Position
srY
    in Map Window PosStoreRectangle -> PositionStore
PS forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
w (Double -> Double -> Double -> Double -> PosStoreRectangle
PSRectangle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
offsetX forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh)
                                               (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
offsetY forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srHt)
                                               (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wh forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh)
                                               (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ht forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srHt)) Map Window PosStoreRectangle
posStoreMap

posStoreRemove :: PositionStore -> Window -> PositionStore
posStoreRemove :: PositionStore -> Window -> PositionStore
posStoreRemove (PS Map Window PosStoreRectangle
posStoreMap) Window
w = Map Window PosStoreRectangle -> PositionStore
PS forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete Window
w Map Window PosStoreRectangle
posStoreMap

posStoreQuery :: PositionStore -> Window -> Rectangle -> Maybe Rectangle
posStoreQuery :: PositionStore -> Window -> Rectangle -> Maybe Rectangle
posStoreQuery (PS Map Window PosStoreRectangle
posStoreMap) Window
w (Rectangle Position
srX Position
srY Dimension
srWh Dimension
srHt) = do
    (PSRectangle Double
x Double
y Double
wh Double
ht) <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Map Window PosStoreRectangle
posStoreMap
    let realWh :: Double
realWh = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh forall a. Num a => a -> a -> a
* Double
wh
        realHt :: Double
realHt = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srHt forall a. Num a => a -> a -> a
* Double
ht
        realOffsetX :: Double
realOffsetX = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh forall a. Num a => a -> a -> a
* Double
x
        realOffsetY :: Double
realOffsetY = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srHt forall a. Num a => a -> a -> a
* Double
y
    forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
srX forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round Double
realOffsetX) (Position
srY forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round Double
realOffsetY)
                        (forall a b. (RealFrac a, Integral b) => a -> b
round Double
realWh) (forall a b. (RealFrac a, Integral b) => a -> b
round Double
realHt))

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