@@ -2,6 +2,7 @@
22Module: Reflex.Vty.Widget
33Description: Basic set of widgets and building blocks for reflex-vty applications
44-}
5+{-# LANGUAGE DeriveFunctor #-}
56{-# LANGUAGE FlexibleContexts #-}
67{-# LANGUAGE FlexibleInstances #-}
78{-# LANGUAGE FunctionalDependencies #-}
@@ -13,6 +14,7 @@ Description: Basic set of widgets and building blocks for reflex-vty application
1314{-# LANGUAGE RecursiveDo #-}
1415{-# LANGUAGE ScopedTypeVariables #-}
1516{-# LANGUAGE StandaloneDeriving #-}
17+{-# LANGUAGE TupleSections #-}
1618{-# LANGUAGE TypeFamilies #-}
1719{-# LANGUAGE UndecidableInstances #-}
1820module Reflex.Vty.Widget
@@ -23,6 +25,14 @@ module Reflex.Vty.Widget
2325 , runVtyWidget
2426 , mainWidget
2527 , mainWidgetWithHandle
28+
29+ , StackWidget(..)
30+ , stack
31+ , Direction(..)
32+ , col
33+ , row
34+ , sized
35+
2636 , HasDisplaySize(..)
2737 , HasFocus(..)
2838 , HasVtyInput(..)
@@ -57,6 +67,7 @@ module Reflex.Vty.Widget
5767 ) where
5868
5969import Control.Applicative (liftA2)
70+import Control.Monad (ap)
6071import Control.Monad.Fix (MonadFix)
6172import Control.Monad.Trans (lift)
6273import Control.Monad.Trans.Reader (ReaderT, runReaderT, asks, ask)
@@ -67,7 +78,7 @@ import qualified Data.Text.Zipper as TZ
6778import Graphics.Vty (Image)
6879import qualified Graphics.Vty as V
6980import Reflex
70−import Reflex.Class.Orphans
81+import Reflex.Class.Orphans ()
7182import Reflex.NotReady.Class
7283import Reflex.NotReady.Class.Orphans ()
7384
@@ -238,22 +249,22 @@ pane
238249 -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.
239250 -> VtyWidget t m a
240251 -> VtyWidget t m a
241−pane (DynRegion l t w h) foc child = VtyWidget $ do
252+pane dr foc child = VtyWidget $ do
242253 ctx <- lift ask
243− let reg = Region <$> l <*> t <*> w <*> h
254+ let reg = currentRegion dr
244255 let ctx' = VtyWidgetCtx
245256 { _vtyWidgetCtx_input = leftmost -- TODO: think about this leftmost more.
246257 [ fmapMaybe id $
247258 attachWith (\(r,f) e -> filterInput r f e)
248− (liftA2 (,) (current reg) (current foc))
259+ (liftA2 (,) reg (current foc))
249260 (_vtyWidgetCtx_input ctx)
250261 ]
251262 , _vtyWidgetCtx_focus = liftA2 (&&) (_vtyWidgetCtx_focus ctx) foc
252− , _vtyWidgetCtx_width = w
253− , _vtyWidgetCtx_height = h
263+ , _vtyWidgetCtx_width = _dynRegion_width dr
264+ , _vtyWidgetCtx_height = _dynRegion_height dr
254265 }
255266 (result, images) <- lift . lift $ runVtyWidget ctx' child
256− let images' = liftA2 (\r is -> map (withinImage r) is) (current reg) images
267+ let images' = liftA2 (\r is -> map (withinImage r) is) reg images
257268 tellImages images'
258269 return result
259270 where
@@ -561,3 +572,60 @@ display
561572 => Behavior t a
562573 -> VtyWidget t m ()
563574display a = text $ T.pack . show <$> a
575+
576+data Direction = Direction_Column
577+ | Direction_Row
578+ deriving (Show, Read, Eq, Ord)
579+
580+newtype StackWidget t m a = StackWidget { unStackWidget :: Direction -> VtyWidget t m (Dynamic t Int, a) }
581+ deriving (Functor)
582+
583+instance (Reflex t, MonadFix m) => Applicative (StackWidget t m) where
584+ pure = return
585+ (<*>) = ap
586+
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+
594+runStackWidget
595+ :: (Reflex t, MonadFix m)
596+ => Direction
597+ -> Dynamic t Int
598+ -> StackWidget t m a
599+ -> VtyWidget t m (Dynamic t Int, a)
600+runStackWidget dir offset x = do
601+ mkRegion <- case dir of
602+ Direction_Column -> (\w sz -> DynRegion 0 offset w sz) <$> displayWidth
603+ Direction_Row -> (\h sz -> DynRegion offset 0 sz h) <$> displayHeight
604+ rec (h, a) <- pane (mkRegion h) (pure True) $ unStackWidget x dir
605+ return (h, a)
606+
607+stack
608+ :: (Reflex t, MonadFix m)
609+ => Direction
610+ -> StackWidget t m a
611+ -> VtyWidget t m a
612+stack dir w = fmap snd $ runStackWidget dir 0 w
613+
614+col
615+ :: (Reflex t, MonadFix m)
616+ => StackWidget t m a
617+ -> VtyWidget t m a
618+col = stack Direction_Column
619+
620+row
621+ :: (Reflex t, MonadFix m)
622+ => StackWidget t m a
623+ -> VtyWidget t m a
624+row = stack Direction_Row
625+
626+sized
627+ :: (Reflex t, MonadFix m)
628+ => Dynamic t Int
629+ -> VtyWidget t m a
630+ -> StackWidget t m a
631+sized sz w = StackWidget $ \_ -> (sz,) <$> w