aboutsummaryrefslogtreecommitdiff
path: root/src/Wetterhorn/Layout
diff options
context:
space:
mode:
Diffstat (limited to 'src/Wetterhorn/Layout')
-rw-r--r--src/Wetterhorn/Layout/Combine.hs45
-rw-r--r--src/Wetterhorn/Layout/Full.hs18
2 files changed, 63 insertions, 0 deletions
diff --git a/src/Wetterhorn/Layout/Combine.hs b/src/Wetterhorn/Layout/Combine.hs
new file mode 100644
index 0000000..983ceb1
--- /dev/null
+++ b/src/Wetterhorn/Layout/Combine.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Wetterhorn.Layout.Combine where
+
+import Data.Typeable
+import Wetterhorn.Constraints
+import Wetterhorn.Core.W
+
+data (|||) a b = Comb LR a b
+ deriving (Typeable, Read, Show)
+
+data Next = Next
+ deriving (Typeable)
+
+data Reset = Reset
+ deriving (Typeable)
+
+(|||) :: a -> b -> (a ||| b)
+a ||| b = Comb L a b
+
+data LR = L | R deriving (Read, Show, Ord, Eq, Enum)
+
+instance (LayoutClass a, LayoutClass b) => LayoutClass (a ||| b) where
+ type C (a ||| b) = C a &&&& C b
+
+ runLayout as (Comb R r l) = do
+ (r', ret) <- runLayout as r
+ return (Comb R r' l, ret)
+ runLayout as (Comb L r l) = do
+ (l', ret) <- runLayout as l
+ return (Comb R r l', ret)
+
+ handleMessage (fromMessage -> Just Next) (Comb L l r) = return (Comb R l r)
+ handleMessage (fromMessage -> Just Reset) (Comb _ l r) = return (Comb L l r)
+ handleMessage mesg (Comb L l r) =
+ Comb L <$> handleMessage mesg l <*> pure r
+ handleMessage mesg (Comb R l r) =
+ Comb L l <$> handleMessage mesg r
+
+ serializeLayout (Comb lr l r) = show (Comb lr (serializeLayout l) (serializeLayout r))
+ readLayout str = Comb lr <$> l <*> r
+ where
+ (Comb lr (readLayout -> l) (readLayout -> r)) = read str
+
+ description (Comb _ l r) = description l ++ " ||| " ++ description r
diff --git a/src/Wetterhorn/Layout/Full.hs b/src/Wetterhorn/Layout/Full.hs
new file mode 100644
index 0000000..8296c7b
--- /dev/null
+++ b/src/Wetterhorn/Layout/Full.hs
@@ -0,0 +1,18 @@
+module Wetterhorn.Layout.Full where
+
+import Data.Data (Typeable)
+import Data.Default
+import Wetterhorn.Constraints
+import Wetterhorn.Core.W
+
+data Full = Full
+ deriving (Read, Show, Typeable)
+
+instance Default Full where
+ def = Full
+
+instance LayoutClass Full where
+ type C Full = Unconstrained
+
+ pureLayout (a : _) _ = [(a, RationalRect 1 1 1 1)]
+ pureLayout _ _ = []