summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSpencer Janssen <sjanssen@cse.unl.edu>2007-05-02 21:59:17 +0200
committerSpencer Janssen <sjanssen@cse.unl.edu>2007-05-02 21:59:17 +0200
commit792a2c7a32a57fe13c348f227fab6463d5ef3bb5 (patch)
tree84e79bc569a1dc0cb4f4ab35369d060662822975
parent5b6a01b9a27012a0b45051ea07c32f6879e54cfd (diff)
downloadmetatile-792a2c7a32a57fe13c348f227fab6463d5ef3bb5.tar
metatile-792a2c7a32a57fe13c348f227fab6463d5ef3bb5.zip
First steps to adding floating layer
darcs-hash:20070502195917-a5988-6831029fae89604c06ae962aaffdf81bfdad3297
-rw-r--r--StackSet.hs31
-rw-r--r--tests/Properties.hs2
2 files changed, 18 insertions, 15 deletions
diff --git a/StackSet.hs b/StackSet.hs
index b455315..f34c215 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -38,12 +38,12 @@ import qualified Data.Map as M
-- stacks, with a current pointer
data StackSet i j a =
StackSet
- { current :: !i -- ^ the currently visible stack
- , screen2ws:: !(M.Map j i) -- ^ screen -> workspace
- , ws2screen:: !(M.Map i j) -- ^ workspace -> screen map
- , stacks :: !(M.Map i [a]) -- ^ the separate stacks
- , focus :: !(M.Map i a) -- ^ the window focused in each stack
- , cache :: !(M.Map a i) -- ^ a cache of windows back to their stacks
+ { current :: !i -- ^ the currently visible stack
+ , screen2ws:: !(M.Map j i) -- ^ screen -> workspace
+ , ws2screen:: !(M.Map i j) -- ^ workspace -> screen map
+ , stacks :: !(M.Map i ([a], [a])) -- ^ screen -> (floating, normal)
+ , focus :: !(M.Map i a) -- ^ the window focused in each stack
+ , cache :: !(M.Map a i) -- ^ a cache of windows back to their stacks
} deriving (Eq, Show)
-- The cache is used to check on insertion that we don't already have
@@ -58,7 +58,7 @@ empty :: (Integral i, Integral j) => Int -> Int -> StackSet i j a
empty n m = StackSet { current = 0
, screen2ws = wsScrs2Works
, ws2screen = wsWorks2Scrs
- , stacks = M.fromList (zip [0..fromIntegral n-1] (repeat []))
+ , stacks = M.fromList (zip [0..fromIntegral n-1] (repeat ([], [])))
, focus = M.empty
, cache = M.empty }
@@ -100,7 +100,7 @@ peekStack i w = M.lookup i (focus w)
-- | /O(log s)/. Index. Extract the stack at workspace 'n'.
-- If the index is invalid, an exception is thrown.
index :: Integral i => i -> StackSet i j a -> [a]
-index k w = fromJust (M.lookup k (stacks w))
+index k w = uncurry (++) $ fromJust $ M.lookup k (stacks w)
-- | view. Set the stack specified by the argument as being visible and the
-- current StackSet. If the stack wasn't previously visible, it will become
@@ -142,7 +142,7 @@ visibleWorkspaces = M.keys . ws2screen
rotate :: (Integral i, Eq a) => Ordering -> StackSet i j a -> StackSet i j a
rotate o w = maybe w id $ do
f <- M.lookup (current w) (focus w)
- s <- M.lookup (current w) (stacks w)
+ s <- fmap (uncurry (++)) $ M.lookup (current w) (stacks w)
ea <- case o of EQ -> Nothing
_ -> elemAfter f (if o == GT then s else reverse s)
return $ w { focus = M.insert (current w) ea (focus w) }
@@ -161,7 +161,7 @@ shift n w = maybe w (\k -> insert k n w) (peek w)
--
insert :: (Integral i, Ord a) => a -> i -> StackSet i j a -> StackSet i j a
insert k n old = new { cache = M.insert k n (cache new)
- , stacks = M.adjust (k:) n (stacks new)
+ , stacks = M.adjust (\(f, ks) -> (f, k:ks)) n (stacks new)
, focus = M.insert n k (focus new) }
where new = delete k old
@@ -172,8 +172,8 @@ delete :: (Integral i, Ord a) => a -> StackSet i j a -> StackSet i j a
delete k w = maybe w del (M.lookup k (cache w))
where
del i = w { cache = M.delete k (cache w)
- , stacks = M.adjust (L.delete k) i (stacks w)
- , focus = M.update (\k' -> if k == k' then elemAfter k (stacks w M.! i)
+ , stacks = M.adjust (\(xs, ys) -> (L.delete k xs, L.delete k ys)) i (stacks w)
+ , focus = M.update (\k' -> if k == k' then elemAfter k (index i w)
else Just k') i (focus w) }
-- | /O(log n)/. If the given window is contained in a workspace, make it the
@@ -188,10 +188,9 @@ raiseFocus k w = case M.lookup k (cache w) of
promote :: (Integral i, Ord a) => StackSet i j a -> StackSet i j a
promote w = maybe w id $ do
a <- peek w -- fail if null
- let w' = w { stacks = M.adjust (\s -> swap a (head s) s) (current w) (stacks w) }
+ let w' = w { stacks = M.adjust (\(f, s) -> (f, swap a (head s) s)) (current w) (stacks w) }
return $ insert a (current w) w' -- and maintain focus (?)
---
-- | Swap first occurences of 'a' and 'b' in list.
-- If both elements are not in the list, the list is unchanged.
--
@@ -214,6 +213,10 @@ swap _ _ xs = xs -- do nothing
-- next xs = last xs : init xs
--
+-- | Returns true if the window is in the floating layer
+isFloat :: (Ord a, Ord i) => a -> StackSet i j a -> Bool
+isFloat k w = maybe False (elem k . fst . (stacks w M.!)) (M.lookup k (cache w))
+
-- | Find the element in the (circular) list after given element.
elemAfter :: Eq a => a -> [a] -> Maybe a
elemAfter w ws = listToMaybe . filter (/= w) . dropWhile (/= w) $ ws ++ ws
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 4924e01..3b57dff 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -167,7 +167,7 @@ prop_shift_reversible r (x :: T) =
prop_fullcache x = cached == allvals where
cached = sort . keys $ cache x
- allvals = sort . concat . elems $ stacks x
+ allvals = sort . concat . map (uncurry (++)) . elems $ stacks x
_ = x :: T
prop_currentwsvisible x = (current x) `elem` (visibleWorkspaces x)