diff options
Diffstat (limited to 'src/Wetterhorn/Layout')
-rw-r--r-- | src/Wetterhorn/Layout/Combine.hs | 45 | ||||
-rw-r--r-- | src/Wetterhorn/Layout/Full.hs | 18 |
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 _ _ = [] |