on develop help sign in
implement LayoutTree and change children to dynamic plus add some helper methods
dac5ed4pdlla
src-bin/example.hs+2−2
@@ -230,9 +230,9 @@ todos todos0 newTodo = do
230 rec tabNav <- tabNavigation
230 rec tabNav <- tabNavigation
231 let insertNav = 1 <$ insert
231 let insertNav = 1 <$ insert
232 navEv = leftmost [tabNav, insertNav]
232 navEv = leftmost [tabNav, insertNav]
233− focusEv = fmap (\(mcur, shift) -> maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` _layoutReturnData_children) mcur) (attach (current _layoutReturnData_focus) navEv)
233+ focusEv = layoutFocusEvFromNavigation navEv lrd
234 tileCfg = def { _tileConfig_constraint = pure $ Constraint_Fixed 1}
234 tileCfg = def { _tileConfig_constraint = pure $ Constraint_Fixed 1}
235− LayoutReturnData {..} <- flip runIsLayoutVtyWidget focusEv $ runLayoutL (pure Orientation_Column) (Just 0) $
235+ lrd@LayoutReturnData {..} <- flip runIsLayoutVtyWidget focusEv $ runLayoutL (pure Orientation_Column) (Just 0) $
236 listHoldWithKey todosMap0 updates $ \k t -> tile tileCfg $ do
236 listHoldWithKey todosMap0 updates $ \k t -> tile tileCfg $ do
237 let sel = select selectOnDelete $ Const2 k
237 let sel = select selectOnDelete $ Const2 k
238 click <- void <$> mouseDown V.BLeft
238 click <- void <$> mouseDown V.BLeft
src/Reflex/Vty/Widget/Layout.hs+128−51
@@ -23,6 +23,8 @@ module Reflex.Vty.Widget.Layout
23 , runLayoutL
23 , runLayoutL
24 , runLayout
24 , runLayout
25 , TileConfig(..)
25 , TileConfig(..)
26+ , clickable
27+ , tile_
26 , tile
28 , tile
27 , fixed
29 , fixed
28 , fixedL
30 , fixedL
@@ -33,10 +35,13 @@ module Reflex.Vty.Widget.Layout
33 , dummyCell
35 , dummyCell
34 , beginLayout
36 , beginLayout
35 , beginLayoutL
37 , beginLayoutL
38+ , layoutFocusEvFromNavigation
36 , tabNavigation
39 , tabNavigation
37 , askOrientation
40 , askOrientation
38 , LayoutVtyWidget(..)
41 , LayoutVtyWidget(..)
39− , LayoutDebugTree(..)
42+ , LayoutTree
43+ , dynLayoutTreeInDynRegion
44+ , layoutTreeCellToPosition
40 , IsLayoutVtyWidget(..)
45 , IsLayoutVtyWidget(..)
41 , LayoutReturnData(..)
46 , LayoutReturnData(..)
42 ) where
47 ) where
@@ -60,6 +65,7 @@ import Data.Monoid hiding (First (..))
60import Data.Ratio ((%))
65import Data.Ratio ((%))
61import Data.Semigroup (First (..))
66import Data.Semigroup (First (..))
62import Data.Traversable (mapAccumL)
67import Data.Traversable (mapAccumL)
68+import qualified Data.Tree as Tree
63import qualified Graphics.Vty as V
69import qualified Graphics.Vty as V
64
70
65import Reflex
71import Reflex
@@ -68,20 +74,20 @@ import Reflex.Vty.Widget
68
74
69-- | The main-axis orientation of a 'Layout' widget
75-- | The main-axis orientation of a 'Layout' widget
70data Orientation = Orientation_Column
76data Orientation = Orientation_Column
71− | Orientation_Row
77+ | Orientation_Row
72− deriving (Show, Read, Eq, Ord)
78+ deriving (Show, Read, Eq, Ord)
73
79
74data LayoutSegment = LayoutSegment
80data LayoutSegment = LayoutSegment
75− { _layoutSegment_offset :: Int
81+ { _layoutSegment_offset :: Int
76− , _layoutSegment_size :: Int
82+ , _layoutSegment_size :: Int
77− }
83+ }
78
84
79data LayoutCtx t = LayoutCtx
85data LayoutCtx t = LayoutCtx
80− { _layoutCtx_regions :: Dynamic t (Map NodeId LayoutSegment)
86+ { _layoutCtx_regions :: Dynamic t (Map NodeId LayoutSegment)
81− , _layoutCtx_focusSelfDemux :: Demux t (Maybe NodeId)
87+ , _layoutCtx_focusSelfDemux :: Demux t (Maybe NodeId)
82− , _layoutCtx_orientation :: Dynamic t Orientation
88+ , _layoutCtx_orientation :: Dynamic t Orientation
83− , _layoutCtx_focusChildSelector :: EventSelector t (Const2 NodeId (Maybe Int))
89+ , _layoutCtx_focusChildSelector :: EventSelector t (Const2 NodeId (Maybe Int))
84− }
90+ }
85
91
86
92
87-- | The Layout monad transformer keeps track of the configuration (e.g., 'Orientation') and
93-- | The Layout monad transformer keeps track of the configuration (e.g., 'Orientation') and
@@ -89,7 +95,7 @@ data LayoutCtx t = LayoutCtx
89-- switchboard for focus requests. See 'tile_' and 'runLayout'.
95-- switchboard for focus requests. See 'tile_' and 'runLayout'.
90newtype Layout t m a = Layout
96newtype Layout t m a = Layout
91 { unLayout :: EventWriterT t (First (NodeId, Int))
97 { 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)])
93 (ReaderT (LayoutCtx t)
99 (ReaderT (LayoutCtx t)
94 (VtyWidget t m))) a
100 (VtyWidget t m))) a
95 } deriving
101 } deriving
@@ -147,6 +153,15 @@ fanFocusEv focussed focusReqIx = fan $ attachWith attachfn focussed focusReqIx w
147 Just (k0,_) -> DMap.fromList [Const2 k0 :=> Identity Nothing,
153 Just (k0,_) -> DMap.fromList [Const2 k0 :=> Identity Nothing,
148 Const2 k1 :=> Identity (Just v1)]
154 Const2 k1 :=> Identity (Just v1)]
149
155
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+
150-- | Run a 'Layout' action
165-- | Run a 'Layout' action
151runLayoutL
166runLayoutL
152 :: forall t m a. (Reflex t, MonadFix m, MonadHold t m)
167 :: forall t m a. (Reflex t, MonadFix m, MonadHold t m)
@@ -160,7 +175,7 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
160 let main = ffor3 ddir dw dh $ \d w h -> case d of
175 let main = ffor3 ddir dw dh $ \d w h -> case d of
161 Orientation_Column -> h
176 Orientation_Column -> h
162 Orientation_Row -> w
177 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
164 let queries = flip appEndo [] <$> queriesEndo
179 let queries = flip appEndo [] <$> queriesEndo
165 solution = ffor2 main queries $ \sz qs -> Map.fromList
180 solution = ffor2 main queries $ \sz qs -> Map.fromList
166 . Map.elems
181 . Map.elems
@@ -170,19 +185,18 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
170 . Map.fromList
185 . Map.fromList
171 . zip [0::Integer ..]
186 . zip [0::Integer ..]
172 $ qs
187 $ qs
173− solutionMap = ffor solution $ \ss -> ffor ss $ \(offset, sz) -> LayoutSegment
188+ solutionMapDyn = ffor solution $ \ss -> ffor ss $ \(offset, sz) -> LayoutSegment
174 { _layoutSegment_offset = offset
189 { _layoutSegment_offset = offset
175 , _layoutSegment_size = sz
190 , _layoutSegment_size = sz
176 }
191 }
177
192
178
193
179− focusableMapAccumFn acc (nodeId, (_, _), _, nKiddos) = (nextAcc, value) where
194+ focusableMapAccumFn acc (nid, (_, _), _, nc) = (nextAcc, value) where
180− nextAcc = acc + nKiddos
195+ nextAcc = acc + nc
181− value = (acc, nodeId)
196+ value = (acc, nid)
182− focusable' = fmap (Bimap.fromList . snd . mapAccumL focusableMapAccumFn 0) $
197+ focusable = fmap (Bimap.fromList . snd . mapAccumL focusableMapAccumFn 0) $
183 ffor queries $ \qs -> fforMaybe qs $ \n@(_, (f, _), _, nc) ->
198 ffor queries $ \qs -> fforMaybe qs $ \n@(_, (f, _), _, nc) ->
184 if f && nc > 0 then Just n else Nothing
199 if f && nc > 0 then Just n else Nothing
185− focusable = focusable'
186
200
187 -- ix is focus in self index space
201 -- ix is focus in self index space
188 -- fst of return value is child node id to focus
202 -- fst of return value is child node id to focus
@@ -205,9 +219,14 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
205 -- TODO handle Nothing case in both places (so that event produces Nothing in this case)
219 -- TODO handle Nothing case in both places (so that event produces Nothing in this case)
206 $ leftmost [ fmap Right . fmap getFirst $ focusReq, Left <$> (fmapMaybe id focusReqIx)]
220 $ leftmost [ fmap Right . fmap getFirst $ focusReq, Left <$> (fmapMaybe id focusReqIx)]
207
221
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
208
225
209 fm0 <- sample . current $ focusable
226 fm0 <- sample . current $ focusable
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
210− totalKiddos <- sample . current $ fmap (sum . fmap (\(_,_,_,k) -> k)) queries
229+ let totalKiddos = fmap (sum . fmap (\(_,(f, _),_,k) -> if f then k else 0)) queries
211
230
212 -- brief explanation of overly complicated focus tracking
231 -- brief explanation of overly complicated focus tracking
213 -- focus is propogated in 2 ways
232 -- focus is propogated in 2 ways
@@ -232,7 +251,7 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
232 focusChildSelector = fanFocusEv (current $ fmap (fmap snd) focussed) (focusReqWithNodeId)
251 focusChildSelector = fanFocusEv (current $ fmap (fmap snd) focussed) (focusReqWithNodeId)
233
252
234 return LayoutReturnData {
253 return LayoutReturnData {
235− _layoutReturnData_tree = emptyLayoutDebugTree
254+ _layoutReturnData_tree = layoutTreeDyn
236 , _layoutReturnData_focus = (fmap (fmap fst)) focussed
255 , _layoutReturnData_focus = (fmap (fmap fst)) focussed
237 , _layoutReturnData_children = totalKiddos
256 , _layoutReturnData_children = totalKiddos
238 , _layoutReturnData_value = a
257 , _layoutReturnData_value = a
@@ -259,7 +278,7 @@ tile_ (TileConfig con focusable) child = mdo
259 nodeId <- getNextNodeId
278 nodeId <- getNextNodeId
260 -- by calling getLayoutTree/getLayoutNumChildren here, we store the children's layout info inside the DynamicWriter
279 -- by calling getLayoutTree/getLayoutNumChildren here, we store the children's layout info inside the DynamicWriter
261 -- runLayoutL will extract this info later
280 -- 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):)
263 seg <- Layout $ asks $
282 seg <- Layout $ asks $
264 fmap (Map.findWithDefault (LayoutSegment 0 0) nodeId) . _layoutCtx_regions
283 fmap (Map.findWithDefault (LayoutSegment 0 0) nodeId) . _layoutCtx_regions
265 dw <- displayWidth
284 dw <- displayWidth
@@ -282,16 +301,17 @@ tile_ (TileConfig con focusable) child = mdo
282 Orientation_Column -> _layoutSegment_size s
301 Orientation_Column -> _layoutSegment_size s
283 Orientation_Row -> c
302 Orientation_Row -> c
284 }
303 }
285− let nKiddos = getLayoutNumChildren @t @b @a b
304+ let nKiddosDyn = getLayoutNumChildren @t @b @a b
286
305
287 focusChildSelector <- Layout $ asks _layoutCtx_focusChildSelector
306 focusChildSelector <- Layout $ asks _layoutCtx_focusChildSelector
288 let focusChildEv = select focusChildSelector (Const2 nodeId)
307 let focusChildEv = select focusChildSelector (Const2 nodeId)
289 focussed <- Layout $ asks _layoutCtx_focusSelfDemux
308 focussed <- Layout $ asks _layoutCtx_focusSelfDemux
290 (focusReq, b) <- Layout $ lift $ lift $ lift $
309 (focusReq, b) <- Layout $ lift $ lift $ lift $
291 pane reg (demuxed focussed $ Just nodeId) $ runIsLayoutVtyWidget child (focusChildEv)
310 pane reg (demuxed focussed $ Just nodeId) $ runIsLayoutVtyWidget child (focusChildEv)
292− Layout $ tellEvent $ if nKiddos > 0
311+ Layout $ tellEvent $
312+ gate (fmap (>0) (current nKiddosDyn))
313+ . fmap (First . swap)
293− then fmap (First . swap) $ attachPromptlyDyn (fmap (fromMaybe 0) $ getLayoutFocussedDyn @t @b @a b) (nodeId <$ focusReq)
314+ $ attachPromptlyDyn (fmap (fromMaybe 0) $ getLayoutFocussedDyn @t @b @a b) (nodeId <$ focusReq)
294− else never
295 return $ getLayoutResult @t b
315 return $ getLayoutResult @t b
296
316
297-- | Tiles are the basic building blocks of 'Layout' widgets. Each tile has a constraint
317-- | Tiles are the basic building blocks of 'Layout' widgets. Each tile has a constraint
@@ -307,11 +327,11 @@ tile = tile_
307
327
308-- | Configuration options for and constraints on 'tile_'
328-- | Configuration options for and constraints on 'tile_'
309data TileConfig t = TileConfig
329data TileConfig t = TileConfig
310− { _tileConfig_constraint :: Dynamic t Constraint
330+ { _tileConfig_constraint :: Dynamic t Constraint
311 -- ^ 'Constraint' on the tile_'s size
331 -- ^ 'Constraint' on the tile_'s size
312− , _tile_Config_focusable :: Dynamic t Bool
332+ , _tile_Config_focusable :: Dynamic t Bool
313 -- ^ Whether the tile_ is focusable
333 -- ^ Whether the tile_ is focusable
314− }
334+ }
315
335
316instance Reflex t => Default (TileConfig t) where
336instance Reflex t => Default (TileConfig t) where
317 def = TileConfig (pure $ Constraint_Min 0) (pure True)
337 def = TileConfig (pure $ Constraint_Min 0) (pure True)
@@ -366,19 +386,19 @@ col
366 :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)
386 :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)
367 => Layout t m a
387 => Layout t m a
368 -> LayoutVtyWidget t m (LayoutReturnData t a)
388 -> 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
370
390
371-- | A version of 'runLayout' that arranges tiles in a row
391-- | A version of 'runLayout' that arranges tiles in a row
372row
392row
373 :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)
393 :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)
374 => Layout t m a
394 => Layout t m a
375 -> LayoutVtyWidget t m (LayoutReturnData t a)
395 -> 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
377
397
378-- | Use to make placeholder empty cells in sub layouts.
398-- | 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 ())
380dummyCell = return LayoutReturnData {
400dummyCell = return LayoutReturnData {
381− _layoutReturnData_tree = emptyLayoutDebugTree
401+ _layoutReturnData_tree = constDyn emptyLayoutTree
382 , _layoutReturnData_focus = constDyn Nothing
402 , _layoutReturnData_focus = constDyn Nothing
383 , _layoutReturnData_children = 0
403 , _layoutReturnData_children = 0
384 , _layoutReturnData_value = ()
404 , _layoutReturnData_value = ()
@@ -403,6 +423,17 @@ clickable child = LayoutVtyWidget . ReaderT $ \focusEv -> do
403 a <- runIsLayoutVtyWidget child focusEv
423 a <- runIsLayoutVtyWidget child focusEv
404 return (() <$ click, a)
424 return (() <$ click, a)
405
425
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+
406-- TODO look into making a variant of this function that takes a navigation event
437-- TODO look into making a variant of this function that takes a navigation event
407-- | Use this variant to begin a layout if you need its "LayoutReturnData"
438-- | Use this variant to begin a layout if you need its "LayoutReturnData"
408beginLayoutL
439beginLayoutL
@@ -413,25 +444,44 @@ beginLayoutL child = mdo
413 -- TODO consider unfocusing if this loses focus
444 -- TODO consider unfocusing if this loses focus
414 --focussed <- focus
445 --focussed <- focus
415 tabEv <- tabNavigation
446 tabEv <- tabNavigation
416− let focusChildEv = fmap (\(mcur, shift) -> maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` _layoutReturnData_children) mcur) (attach (current _layoutReturnData_focus) tabEv)
447+ let
448+ focusChildEv = layoutFocusEvFromNavigation tabEv lrd
417− lrd@LayoutReturnData{..} <- runIsLayoutVtyWidget child focusChildEv
449+ lrd <- runIsLayoutVtyWidget child focusChildEv
418 return lrd
450 return lrd
419
451
420-- | Begin a layout using tab and shift-tab to navigate
452-- | Begin a layout using tab and shift-tab to navigate
421beginLayout
453beginLayout
422− :: (Reflex t, MonadHold t m, MonadFix m, MonadNodeId m)
454+ :: (Reflex t, MonadHold t m, MonadFix m)
423 => LayoutVtyWidget t m (LayoutReturnData t a)
455 => LayoutVtyWidget t m (LayoutReturnData t a)
424 -> VtyWidget t m a
456 -> VtyWidget t m a
425beginLayout = fmap _layoutReturnData_value . beginLayoutL
457beginLayout = fmap _layoutReturnData_value . beginLayoutL
426
458
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+
427-- | Retrieve the current orientation of a 'Layout'
477-- | Retrieve the current orientation of a 'Layout'
428askOrientation :: Monad m => Layout t m (Dynamic t Orientation)
478askOrientation :: Monad m => Layout t m (Dynamic t Orientation)
429askOrientation = Layout $ asks _layoutCtx_orientation
479askOrientation = Layout $ asks _layoutCtx_orientation
430
480
431-- | Datatype representing constraints on a widget's size along the main axis (see 'Orientation')
481-- | Datatype representing constraints on a widget's size along the main axis (see 'Orientation')
432data Constraint = Constraint_Fixed Int
482data Constraint = Constraint_Fixed Int
433− | Constraint_Min Int
483+ | Constraint_Min Int
434− deriving (Show, Read, Eq, Ord)
484+ deriving (Show, Read, Eq, Ord)
435
485
436-- | Compute the size of each widget "@k@" based on the total set of 'Constraint's
486-- | Compute the size of each widget "@k@" based on the total set of 'Constraint's
437computeSizes
487computeSizes
@@ -457,27 +507,54 @@ computeEdges :: (Ord k) => Map k (a, Int) -> Map k (a, (Int, Int))
457computeEdges = fst . Map.foldlWithKey' (\(m, offset) k (a, sz) ->
507computeEdges = fst . Map.foldlWithKey' (\(m, offset) k (a, sz) ->
458 (Map.insert k (a, (offset, sz)) m, sz + offset)) (Map.empty, 0)
508 (Map.insert k (a, (offset, sz)) m, sz + offset)) (Map.empty, 0)
459
509
460−-- TODO FINISH
510+
461−-- but it's weird cuz a leaf node won't know it's PosDim until combined with a Region...
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+
462-- | Dynamic sizing information on a layout hierarchy (intended for testing)
520-- | Dynamic sizing information on a layout hierarchy (intended for testing)
463−data LayoutDebugTree t = LayoutDebugTree_Branch [LayoutDebugTree t]
521+type LayoutTree = Tree.Tree Region
464− | LayoutDebugTree_Leaf
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
465
528
466−emptyLayoutDebugTree :: LayoutDebugTree t
529+infix 9 !!?
467−emptyLayoutDebugTree = LayoutDebugTree_Leaf
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
468
545
469class IsLayoutReturn t b a where
546class IsLayoutReturn t b a where
470 getLayoutResult :: b -> a
547 getLayoutResult :: b -> a
471− getLayoutNumChildren :: b -> Int
548+ getLayoutNumChildren :: b -> Dynamic t Int
472 getLayoutFocussedDyn :: b -> Dynamic t (Maybe Int)
549 getLayoutFocussedDyn :: b -> Dynamic t (Maybe Int)
473− getLayoutTree :: b -> LayoutDebugTree t
550+ getLayoutTree :: b -> Dynamic t LayoutTree
474
551
475−data LayoutReturnData t a = LayoutReturnData
552+data LayoutReturnData t a = LayoutReturnData {
476− { _layoutReturnData_tree :: LayoutDebugTree t
553+ _layoutReturnData_tree :: Dynamic t LayoutTree
477 , _layoutReturnData_focus :: Dynamic t (Maybe Int)
554 , _layoutReturnData_focus :: Dynamic t (Maybe Int)
478− , _layoutReturnData_children :: Int
555+ , _layoutReturnData_children :: Dynamic t Int
479 , _layoutReturnData_value :: a
556 , _layoutReturnData_value :: a
480− }
557+ }
481
558
482instance IsLayoutReturn t (LayoutReturnData t a) a where
559instance IsLayoutReturn t (LayoutReturnData t a) a where
483 getLayoutResult lrd = _layoutReturnData_value lrd
560 getLayoutResult lrd = _layoutReturnData_value lrd
@@ -489,7 +566,7 @@ instance Reflex t => IsLayoutReturn t a a where
489 getLayoutResult = id
566 getLayoutResult = id
490 getLayoutNumChildren _ = 1
567 getLayoutNumChildren _ = 1
491 getLayoutFocussedDyn _ = constDyn Nothing
568 getLayoutFocussedDyn _ = constDyn Nothing
492− getLayoutTree _ = emptyLayoutDebugTree
569+ getLayoutTree _ = constDyn emptyLayoutTree
493
570
494class IsLayoutVtyWidget l t m where
571class IsLayoutVtyWidget l t m where
495 runIsLayoutVtyWidget :: l t m a -> Event t (Maybe Int) -> VtyWidget t m a
572 runIsLayoutVtyWidget :: l t m a -> Event t (Maybe Int) -> VtyWidget t m a