----------------------------------------------------------------------------
-- |
-- 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]
(Int -> ReadS PositionStore)
-> ReadS [PositionStore]
-> ReadPrec PositionStore
-> ReadPrec [PositionStore]
-> Read PositionStore
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PositionStore
readsPrec :: Int -> ReadS PositionStore
$creadList :: ReadS [PositionStore]
readList :: ReadS [PositionStore]
$creadPrec :: ReadPrec PositionStore
readPrec :: ReadPrec PositionStore
$creadListPrec :: ReadPrec [PositionStore]
readListPrec :: ReadPrec [PositionStore]
Read,Int -> PositionStore -> ShowS
[PositionStore] -> ShowS
PositionStore -> String
(Int -> PositionStore -> ShowS)
-> (PositionStore -> String)
-> ([PositionStore] -> ShowS)
-> Show PositionStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PositionStore -> ShowS
showsPrec :: Int -> PositionStore -> ShowS
$cshow :: PositionStore -> String
show :: PositionStore -> String
$cshowList :: [PositionStore] -> ShowS
showList :: [PositionStore] -> ShowS
Show)
data PosStoreRectangle = PSRectangle Double Double Double Double
                            deriving (ReadPrec [PosStoreRectangle]
ReadPrec PosStoreRectangle
Int -> ReadS PosStoreRectangle
ReadS [PosStoreRectangle]
(Int -> ReadS PosStoreRectangle)
-> ReadS [PosStoreRectangle]
-> ReadPrec PosStoreRectangle
-> ReadPrec [PosStoreRectangle]
-> Read PosStoreRectangle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PosStoreRectangle
readsPrec :: Int -> ReadS PosStoreRectangle
$creadList :: ReadS [PosStoreRectangle]
readList :: ReadS [PosStoreRectangle]
$creadPrec :: ReadPrec PosStoreRectangle
readPrec :: ReadPrec PosStoreRectangle
$creadListPrec :: ReadPrec [PosStoreRectangle]
readListPrec :: ReadPrec [PosStoreRectangle]
Read,Int -> PosStoreRectangle -> ShowS
[PosStoreRectangle] -> ShowS
PosStoreRectangle -> String
(Int -> PosStoreRectangle -> ShowS)
-> (PosStoreRectangle -> String)
-> ([PosStoreRectangle] -> ShowS)
-> Show PosStoreRectangle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PosStoreRectangle -> ShowS
showsPrec :: Int -> PosStoreRectangle -> ShowS
$cshow :: PosStoreRectangle -> String
show :: PosStoreRectangle -> String
$cshowList :: [PosStoreRectangle] -> ShowS
showList :: [PosStoreRectangle] -> ShowS
Show)

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

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

modifyPosStore :: (PositionStore -> PositionStore) -> X ()
modifyPosStore :: (PositionStore -> PositionStore) -> X ()
modifyPosStore = (PositionStore -> PositionStore) -> X ()
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
srX
        offsetY :: Position
offsetY = Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
srY
    in Map Window PosStoreRectangle -> PositionStore
PS (Map Window PosStoreRectangle -> PositionStore)
-> Map Window PosStoreRectangle -> PositionStore
forall a b. (a -> b) -> a -> b
$ Window
-> PosStoreRectangle
-> Map Window PosStoreRectangle
-> Map Window PosStoreRectangle
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
w (Double -> Double -> Double -> Double -> PosStoreRectangle
PSRectangle (Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
offsetX Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh)
                                               (Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
offsetY Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srHt)
                                               (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wh Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh)
                                               (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ht Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Dimension -> Double
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 (Map Window PosStoreRectangle -> PositionStore)
-> Map Window PosStoreRectangle -> PositionStore
forall a b. (a -> b) -> a -> b
$ Window
-> Map Window PosStoreRectangle -> Map Window PosStoreRectangle
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) <- Window -> Map Window PosStoreRectangle -> Maybe PosStoreRectangle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Map Window PosStoreRectangle
posStoreMap
    let realWh :: Double
realWh = Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wh
        realHt :: Double
realHt = Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srHt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ht
        realOffsetX :: Double
realOffsetX = Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srWh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x
        realOffsetY :: Double
realOffsetY = Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
srHt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y
    Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
srX Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Double -> Position
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
realOffsetX) (Position
srY Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Double -> Position
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
realOffsetY)
                        (Double -> Dimension
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
realWh) (Double -> Dimension
forall b. Integral b => Double -> b
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