@@ -23,6 +23,8 @@ module Reflex.Vty.Widget.Layout
2323 , runLayoutL
2424 , runLayout
2525 , TileConfig(..)
26+ , clickable
27+ , tile_
2628 , tile
2729 , fixed
2830 , fixedL
@@ -33,10 +35,13 @@ module Reflex.Vty.Widget.Layout
3335 , dummyCell
3436 , beginLayout
3537 , beginLayoutL
38+ , layoutFocusEvFromNavigation
3639 , tabNavigation
3740 , askOrientation
3841 , LayoutVtyWidget(..)
39− , LayoutDebugTree(..)
42+ , LayoutTree
43+ , dynLayoutTreeInDynRegion
44+ , layoutTreeCellToPosition
4045 , IsLayoutVtyWidget(..)
4146 , LayoutReturnData(..)
4247 ) where
@@ -60,6 +65,7 @@ import Data.Monoid hiding (First (..))
6065import Data.Ratio ((%))
6166import Data.Semigroup (First (..))
6267import Data.Traversable (mapAccumL)
68+import qualified Data.Tree as Tree
6369import qualified Graphics.Vty as V
6470
6571import Reflex
@@ -68,20 +74,20 @@ import Reflex.Vty.Widget
6874
6975-- | The main-axis orientation of a 'Layout' widget
7076data Orientation = Orientation_Column
71− | Orientation_Row
72− deriving (Show, Read, Eq, Ord)
77+ | Orientation_Row
78+ deriving (Show, Read, Eq, Ord)
7379
7480data LayoutSegment = LayoutSegment
75− { _layoutSegment_offset :: Int
76− , _layoutSegment_size :: Int
77− }
81+ { _layoutSegment_offset :: Int
82+ , _layoutSegment_size :: Int
83+ }
7884
7985data LayoutCtx t = LayoutCtx
80− { _layoutCtx_regions :: Dynamic t (Map NodeId LayoutSegment)
81− , _layoutCtx_focusSelfDemux :: Demux t (Maybe NodeId)
82− , _layoutCtx_orientation :: Dynamic t Orientation
83− , _layoutCtx_focusChildSelector :: EventSelector t (Const2 NodeId (Maybe Int))
84− }
86+ { _layoutCtx_regions :: Dynamic t (Map NodeId LayoutSegment)
87+ , _layoutCtx_focusSelfDemux :: Demux t (Maybe NodeId)
88+ , _layoutCtx_orientation :: Dynamic t Orientation
89+ , _layoutCtx_focusChildSelector :: EventSelector t (Const2 NodeId (Maybe Int))
90+ }
8591
8692
8793-- | The Layout monad transformer keeps track of the configuration (e.g., 'Orientation') and
@@ -89,7 +95,7 @@ data LayoutCtx t = LayoutCtx
8995-- switchboard for focus requests. See 'tile_' and 'runLayout'.
9096newtype Layout t m a = Layout
9197 { unLayout :: EventWriterT t (First (NodeId, Int))
92− (DynamicWriterT t (Endo [(NodeId, (Bool, Constraint), LayoutDebugTree t, Int)])
98+ (DynamicWriterT t (Endo [(NodeId, (Bool, Constraint), Dynamic t LayoutTree, Int)])
9399 (ReaderT (LayoutCtx t)
94100 (VtyWidget t m))) a
95101 } deriving
@@ -147,6 +153,15 @@ fanFocusEv focussed focusReqIx = fan $ attachWith attachfn focussed focusReqIx w
147153 Just (k0,_) -> DMap.fromList [Const2 k0 :=> Identity Nothing,
148154 Const2 k1 :=> Identity (Just v1)]
149155
156+
157+translateLayoutTree :: (Reflex t) => Orientation -> NodeId -> Dynamic t (Map NodeId LayoutSegment) -> Dynamic t LayoutTree -> Dynamic t LayoutTree
158+translateLayoutTree orient nid solutionMap dlt = ffor2 solutionMap dlt fn where
159+ fn sm lt = result where
160+ ls = fromMaybe (error "expected result") (Map.lookup nid sm)
161+ result = ffor lt $ \reg -> if orient == Orientation_Row
162+ then offsetRegion (_layoutSegment_offset ls, 0) reg
163+ else offsetRegion (0, _layoutSegment_offset ls) reg
164+
150165-- | Run a 'Layout' action
151166runLayoutL
152167 :: forall t m a. (Reflex t, MonadFix m, MonadHold t m)
@@ -160,7 +175,7 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
160175 let main = ffor3 ddir dw dh $ \d w h -> case d of
161176 Orientation_Column -> h
162177 Orientation_Row -> w
163− ((a, focusReq), queriesEndo) <- runReaderT (runDynamicWriterT $ runEventWriterT child) $ LayoutCtx solutionMap focusDemux ddir focusChildSelector
178+ ((a, focusReq), queriesEndo) <- runReaderT (runDynamicWriterT $ runEventWriterT child) $ LayoutCtx solutionMapDyn focusDemux ddir focusChildSelector
164179 let queries = flip appEndo [] <$> queriesEndo
165180 solution = ffor2 main queries $ \sz qs -> Map.fromList
166181 . Map.elems
@@ -170,19 +185,18 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
170185 . Map.fromList
171186 . zip [0::Integer ..]
172187 $ qs
173− solutionMap = ffor solution $ \ss -> ffor ss $ \(offset, sz) -> LayoutSegment
188+ solutionMapDyn = ffor solution $ \ss -> ffor ss $ \(offset, sz) -> LayoutSegment
174189 { _layoutSegment_offset = offset
175190 , _layoutSegment_size = sz
176191 }
177192
178193
179− focusableMapAccumFn acc (nodeId, (_, _), _, nKiddos) = (nextAcc, value) where
180− nextAcc = acc + nKiddos
181− value = (acc, nodeId)
182− focusable' = fmap (Bimap.fromList . snd . mapAccumL focusableMapAccumFn 0) $
194+ focusableMapAccumFn acc (nid, (_, _), _, nc) = (nextAcc, value) where
195+ nextAcc = acc + nc
196+ value = (acc, nid)
197+ focusable = fmap (Bimap.fromList . snd . mapAccumL focusableMapAccumFn 0) $
183198 ffor queries $ \qs -> fforMaybe qs $ \n@(_, (f, _), _, nc) ->
184199 if f && nc > 0 then Just n else Nothing
185− focusable = focusable'
186200
187201 -- ix is focus in self index space
188202 -- fst of return value is child node id to focus
@@ -205,9 +219,14 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
205219 -- TODO handle Nothing case in both places (so that event produces Nothing in this case)
206220 $ leftmost [ fmap Right . fmap getFirst $ focusReq, Left <$> (fmapMaybe id focusReqIx)]
207221
222+ let
223+ forestDyn :: Dynamic t [LayoutTree] = join . fmap distributeListOverDyn $ ffor2 queries ddir $ \qs dir -> ffor qs $ \(nid,_,dlt,_) -> translateLayoutTree dir nid solutionMapDyn dlt
224+ layoutTreeDyn :: Dynamic t LayoutTree = ffor3 forestDyn dw dh $ \f w h -> Tree.Node (Region 0 0 w h) f
208225
209226 fm0 <- sample . current $ focusable
210− totalKiddos <- sample . current $ fmap (sum . fmap (\(_,_,_,k) -> k)) queries
227+ -- TODO this is dependent on focusable-ness of children so _layoutReturnData_children should be changed to dynamic...
228+ -- TODO consider removing dynamic from focus/constraint instead
229+ let totalKiddos = fmap (sum . fmap (\(_,(f, _),_,k) -> if f then k else 0)) queries
211230
212231 -- brief explanation of overly complicated focus tracking
213232 -- focus is propogated in 2 ways
@@ -232,7 +251,7 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
232251 focusChildSelector = fanFocusEv (current $ fmap (fmap snd) focussed) (focusReqWithNodeId)
233252
234253 return LayoutReturnData {
235− _layoutReturnData_tree = emptyLayoutDebugTree
254+ _layoutReturnData_tree = layoutTreeDyn
236255 , _layoutReturnData_focus = (fmap (fmap fst)) focussed
237256 , _layoutReturnData_children = totalKiddos
238257 , _layoutReturnData_value = a
@@ -259,7 +278,7 @@ tile_ (TileConfig con focusable) child = mdo
259278 nodeId <- getNextNodeId
260279 -- by calling getLayoutTree/getLayoutNumChildren here, we store the children's layout info inside the DynamicWriter
261280 -- runLayoutL will extract this info later
262− Layout $ tellDyn $ ffor2 con focusable $ \c f -> Endo ((nodeId, (f, c), getLayoutTree @t @b @a b, nKiddos):)
281+ Layout $ tellDyn $ ffor3 con focusable nKiddosDyn $ \c f n -> Endo ((nodeId, (f, c), getLayoutTree @t @b @a b, n):)
263282 seg <- Layout $ asks $
264283 fmap (Map.findWithDefault (LayoutSegment 0 0) nodeId) . _layoutCtx_regions
265284 dw <- displayWidth
@@ -282,16 +301,17 @@ tile_ (TileConfig con focusable) child = mdo
282301 Orientation_Column -> _layoutSegment_size s
283302 Orientation_Row -> c
284303 }
285− let nKiddos = getLayoutNumChildren @t @b @a b
304+ let nKiddosDyn = getLayoutNumChildren @t @b @a b
286305
287306 focusChildSelector <- Layout $ asks _layoutCtx_focusChildSelector
288307 let focusChildEv = select focusChildSelector (Const2 nodeId)
289308 focussed <- Layout $ asks _layoutCtx_focusSelfDemux
290309 (focusReq, b) <- Layout $ lift $ lift $ lift $
291310 pane reg (demuxed focussed $ Just nodeId) $ runIsLayoutVtyWidget child (focusChildEv)
292− Layout $ tellEvent $ if nKiddos > 0
293− then fmap (First . swap) $ attachPromptlyDyn (fmap (fromMaybe 0) $ getLayoutFocussedDyn @t @b @a b) (nodeId <$ focusReq)
294− else never
311+ Layout $ tellEvent $
312+ gate (fmap (>0) (current nKiddosDyn))
313+ . fmap (First . swap)
314+ $ attachPromptlyDyn (fmap (fromMaybe 0) $ getLayoutFocussedDyn @t @b @a b) (nodeId <$ focusReq)
295315 return $ getLayoutResult @t b
296316
297317-- | Tiles are the basic building blocks of 'Layout' widgets. Each tile has a constraint
@@ -307,11 +327,11 @@ tile = tile_
307327
308328-- | Configuration options for and constraints on 'tile_'
309329data TileConfig t = TileConfig
310− { _tileConfig_constraint :: Dynamic t Constraint
330+ { _tileConfig_constraint :: Dynamic t Constraint
311331 -- ^ 'Constraint' on the tile_'s size
312− , _tile_Config_focusable :: Dynamic t Bool
332+ , _tile_Config_focusable :: Dynamic t Bool
313333 -- ^ Whether the tile_ is focusable
314− }
334+ }
315335
316336instance Reflex t => Default (TileConfig t) where
317337 def = TileConfig (pure $ Constraint_Min 0) (pure True)
@@ -366,19 +386,19 @@ col
366386 :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)
367387 => Layout t m a
368388 -> LayoutVtyWidget t m (LayoutReturnData t a)
369−col child = runLayoutL (pure Orientation_Column) (Just 0) child
389+col child = runLayoutL (pure Orientation_Column) (Nothing) child
370390
371391-- | A version of 'runLayout' that arranges tiles in a row
372392row
373393 :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)
374394 => Layout t m a
375395 -> LayoutVtyWidget t m (LayoutReturnData t a)
376−row child = runLayoutL (pure Orientation_Row) (Just 0) child
396+row child = runLayoutL (pure Orientation_Row) (Nothing) child
377397
378398-- | Use to make placeholder empty cells in sub layouts.
379−dummyCell :: (Reflex t, Monad m) => LayoutVtyWidget t m (LayoutReturnData t ())
399+dummyCell :: (Reflex t, Monad m) => (Reflex t) => LayoutVtyWidget t m (LayoutReturnData t ())
380400dummyCell = return LayoutReturnData {
381− _layoutReturnData_tree = emptyLayoutDebugTree
401+ _layoutReturnData_tree = constDyn emptyLayoutTree
382402 , _layoutReturnData_focus = constDyn Nothing
383403 , _layoutReturnData_children = 0
384404 , _layoutReturnData_value = ()
@@ -403,6 +423,17 @@ clickable child = LayoutVtyWidget . ReaderT $ \focusEv -> do
403423 a <- runIsLayoutVtyWidget child focusEv
404424 return (() <$ click, a)
405425
426+-- | create a focus event (to be used with runIsLayoutVtyWidget) from a navigation event
427+layoutFocusEvFromNavigation
428+ :: (Reflex t)
429+ => Event t Int
430+ -> LayoutReturnData t a
431+ -> Event t (Maybe Int)
432+layoutFocusEvFromNavigation navEv LayoutReturnData {..} = r where
433+ fmapfn (nKiddos, (mcur, shift)) = maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` nKiddos) mcur
434+ navEv' = attach (current _layoutReturnData_children) $ attach (current _layoutReturnData_focus) navEv
435+ r = fmap fmapfn navEv'
436+
406437-- TODO look into making a variant of this function that takes a navigation event
407438-- | Use this variant to begin a layout if you need its "LayoutReturnData"
408439beginLayoutL
@@ -413,25 +444,44 @@ beginLayoutL child = mdo
413444 -- TODO consider unfocusing if this loses focus
414445 --focussed <- focus
415446 tabEv <- tabNavigation
416− let focusChildEv = fmap (\(mcur, shift) -> maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` _layoutReturnData_children) mcur) (attach (current _layoutReturnData_focus) tabEv)
417− lrd@LayoutReturnData{..} <- runIsLayoutVtyWidget child focusChildEv
447+ let
448+ focusChildEv = layoutFocusEvFromNavigation tabEv lrd
449+ lrd <- runIsLayoutVtyWidget child focusChildEv
418450 return lrd
419451
420452-- | Begin a layout using tab and shift-tab to navigate
421453beginLayout
422− :: (Reflex t, MonadHold t m, MonadFix m, MonadNodeId m)
454+ :: (Reflex t, MonadHold t m, MonadFix m)
423455 => LayoutVtyWidget t m (LayoutReturnData t a)
424456 -> VtyWidget t m a
425457beginLayout = fmap _layoutReturnData_value . beginLayoutL
426458
459+{- something like this
460+beginLayoutL
461+ :: (Reflex t, MonadHold t m, MonadFix m)
462+ => LayoutVtyWidget t m (LayoutReturnData t a)
463+ -> Maybe (Event t Int)
464+ -> VtyWidget t m (LayoutReturnData t a)
465+beginLayoutL mNavEv child = mdo
466+ -- TODO consider unfocusing if this loses focus
467+ --focussed <- focus
468+ let
469+ focusChildEv = case mNavEv of
470+ Just navEv -> layoutFocusEvFromNavigation navEv lrd
471+ Nothing -> never
472+ lrd <- runIsLayoutVtyWidget child focusChildEv
473+ return lrd
474+-}
475+
476+
427477-- | Retrieve the current orientation of a 'Layout'
428478askOrientation :: Monad m => Layout t m (Dynamic t Orientation)
429479askOrientation = Layout $ asks _layoutCtx_orientation
430480
431481-- | Datatype representing constraints on a widget's size along the main axis (see 'Orientation')
432482data Constraint = Constraint_Fixed Int
433− | Constraint_Min Int
434− deriving (Show, Read, Eq, Ord)
483+ | Constraint_Min Int
484+ deriving (Show, Read, Eq, Ord)
435485
436486-- | Compute the size of each widget "@k@" based on the total set of 'Constraint's
437487computeSizes
@@ -457,27 +507,54 @@ computeEdges :: (Ord k) => Map k (a, Int) -> Map k (a, (Int, Int))
457507computeEdges = fst . Map.foldlWithKey' (\(m, offset) k (a, sz) ->
458508 (Map.insert k (a, (offset, sz)) m, sz + offset)) (Map.empty, 0)
459509
460−-- TODO FINISH
461−-- but it's weird cuz a leaf node won't know it's PosDim until combined with a Region...
510+
511+
512+offsetRegion :: (Int, Int) -> Region -> Region
513+offsetRegion (x,y) reg = reg {
514+ _region_left = x+x'
515+ , _region_top = y+y'
516+ } where
517+ x' = _region_left reg
518+ y' = _region_top reg
519+
462520-- | Dynamic sizing information on a layout hierarchy (intended for testing)
463−data LayoutDebugTree t = LayoutDebugTree_Branch [LayoutDebugTree t]
464− | LayoutDebugTree_Leaf
521+type LayoutTree = Tree.Tree Region
522+
523+emptyLayoutTree :: LayoutTree
524+emptyLayoutTree = Tree.Node (Region 0 0 0 0) []
525+
526+dynLayoutTreeInDynRegion :: (Reflex t) => DynRegion t -> Dynamic t LayoutTree -> Dynamic t LayoutTree
527+dynLayoutTreeInDynRegion DynRegion {..} dlt = ffor3 _dynRegion_left _dynRegion_top dlt $ \x y lt -> fmap (offsetRegion (x,y)) lt
465528
466−emptyLayoutDebugTree :: LayoutDebugTree t
467−emptyLayoutDebugTree = LayoutDebugTree_Leaf
529+infix 9 !!?
530+(!!?) :: [a] -> Int -> Maybe a
531+(!!?) xs i
532+ | i < 0 = Nothing
533+ | otherwise = go i xs
534+ where
535+ go :: Int -> [a] -> Maybe a
536+ go 0 (x:_) = Just x
537+ go j (_:ys) = go (j - 1) ys
538+ go _ [] = Nothing
539+{-# INLINE (!!?) #-}
540+
541+-- | gives top left corner of the cell following directions
542+layoutTreeCellToPosition :: [Int] -> LayoutTree -> Maybe (Int, Int)
543+layoutTreeCellToPosition [] (Tree.Node region _) = Just (_region_left region, _region_top region)
544+layoutTreeCellToPosition (x:xs) (Tree.Node _ kiddos) = kiddos !!? x >>= layoutTreeCellToPosition xs
468545
469546class IsLayoutReturn t b a where
470547 getLayoutResult :: b -> a
471− getLayoutNumChildren :: b -> Int
548+ getLayoutNumChildren :: b -> Dynamic t Int
472549 getLayoutFocussedDyn :: b -> Dynamic t (Maybe Int)
473− getLayoutTree :: b -> LayoutDebugTree t
550+ getLayoutTree :: b -> Dynamic t LayoutTree
474551
475−data LayoutReturnData t a = LayoutReturnData
476− { _layoutReturnData_tree :: LayoutDebugTree t
552+data LayoutReturnData t a = LayoutReturnData {
553+ _layoutReturnData_tree :: Dynamic t LayoutTree
477554 , _layoutReturnData_focus :: Dynamic t (Maybe Int)
478− , _layoutReturnData_children :: Int
555+ , _layoutReturnData_children :: Dynamic t Int
479556 , _layoutReturnData_value :: a
480− }
557+ }
481558
482559instance IsLayoutReturn t (LayoutReturnData t a) a where
483560 getLayoutResult lrd = _layoutReturnData_value lrd
@@ -489,7 +566,7 @@ instance Reflex t => IsLayoutReturn t a a where
489566 getLayoutResult = id
490567 getLayoutNumChildren _ = 1
491568 getLayoutFocussedDyn _ = constDyn Nothing
492− getLayoutTree _ = emptyLayoutDebugTree
569+ getLayoutTree _ = constDyn emptyLayoutTree
493570
494571class IsLayoutVtyWidget l t m where
495572 runIsLayoutVtyWidget :: l t m a -> Event t (Maybe Int) -> VtyWidget t m a