@@ -64,6 +64,10 @@ module Reflex.Vty.Widget
6464 , doubleBoxStyle
6565 , fill
6666 , hRule
67+ , KeyCombo
68+ , key
69+ , keys
70+ , keyCombos
6771 ) where
6872
6973import Control.Applicative (liftA2)
@@ -72,6 +76,9 @@ import Control.Monad.Fix (MonadFix)
7276import Control.Monad.Trans (lift)
7377import Control.Monad.Trans.Reader (ReaderT, runReaderT, asks, ask)
7478import Data.Default (Default(..))
79+import Data.Monoid (Sum(..))
80+import Data.Set (Set)
81+import qualified Data.Set as Set
7582import Data.Text (Text)
7683import qualified Data.Text as T
7784import qualified Data.Text.Zipper as TZ
@@ -364,6 +371,26 @@ data MouseUp = MouseUp
364371 }
365372 deriving (Eq, Ord, Show)
366373
374+type KeyCombo = (V.Key, [V.Modifier])
375+
376+key :: (Monad m, Reflex t) => V.Key -> VtyWidget t m (Event t KeyCombo)
377+key = keyCombos . Set.singleton . (,[])
378+
379+keys :: (Monad m, Reflex t) => [V.Key] -> VtyWidget t m (Event t KeyCombo)
380+keys = keyCombos . Set.fromList . fmap (,[])
381+
382+keyCombos
383+ :: (Reflex t, Monad m)
384+ => Set KeyCombo
385+ -> VtyWidget t m (Event t KeyCombo)
386+keyCombos ks = do
387+ i <- input
388+ return $ fforMaybe i $ \case
389+ V.EvKey k m -> if Set.member (k, m) ks
390+ then Just (k, m)
391+ else Nothing
392+ _ -> Nothing
393+
367394-- | A plain split of the available space into vertically stacked panes.
368395-- No visual separator is built in here.
369396splitV :: (Reflex t, Monad m)
@@ -577,33 +604,37 @@ data Direction = Direction_Column
577604 | Direction_Row
578605 deriving (Show, Read, Eq, Ord)
579606
580−newtype StackWidget t m a = StackWidget { unStackWidget :: Direction -> VtyWidget t m (Dynamic t Int, a) }
581− deriving (Functor)
607+newtype StackWidget t m a = StackWidget { unStackWidget :: ReaderT Direction (DynamicWriterT t (Sum Int) (VtyWidget t m)) a }
608+ deriving (Functor, MonadSample t, MonadHold t, MonadFix, NotReady t)
582609
583610instance (Reflex t, MonadFix m) => Applicative (StackWidget t m) where
584611 pure = return
585612 (<*>) = ap
586613
587−instance (MonadFix m, Reflex t) => Monad (StackWidget t m) where
588− w >>= g = StackWidget $ \dir -> do
589− (sz, r) <- runStackWidget dir 0 w
590− (sz', r') <- runStackWidget dir sz (g r)
591− return (sz + sz', r')
592− return x = StackWidget $ \_ -> return (0, x)
593−
594614runStackWidget
595615 :: (Reflex t, MonadFix m)
596616 => Direction
597617 -> Dynamic t Int
598618 -> StackWidget t m a
599− -> VtyWidget t m (Dynamic t Int, a)
619+ -> VtyWidget t m (Dynamic t (Sum Int), a)
600620runStackWidget dir offset x = do
601621 mkRegion <- case dir of
602622 Direction_Column -> (\w sz -> DynRegion 0 offset w sz) <$> displayWidth
603623 Direction_Row -> (\h sz -> DynRegion offset 0 sz h) <$> displayHeight
604− rec (h, a) <- pane (mkRegion h) (pure True) $ unStackWidget x dir
624+ rec (a, h) <- pane (mkRegion h') (pure True) $ runDynamicWriterT $ runReaderT (unStackWidget x) dir
625+ let h' = getSum <$> h
605626 return (h, a)
606627
628+instance (MonadFix m, Reflex t) => Monad (StackWidget t m) where
629+ w >>= g = StackWidget $ do
630+ dir <- ask
631+ (sz, r) <- lift $ lift $ runStackWidget dir 0 w
632+ tellDyn sz
633+ (sz', r') <- lift $ lift $ runStackWidget dir (getSum <$> sz) (g r)
634+ tellDyn sz'
635+ return r'
636+ return x = StackWidget $ return x
637+
607638stack
608639 :: (Reflex t, MonadFix m)
609640 => Direction
@@ -628,4 +659,6 @@ sized
628659 => Dynamic t Int
629660 -> VtyWidget t m a
630661 -> StackWidget t m a
631−sized sz w = StackWidget $ \_ -> (sz,) <$> w
662+sized sz w = StackWidget $ do
663+ tellDyn $ Sum <$> sz
664+ lift $ lift w