on develop help sign in
fix unfocus behavior in layout
commited239d346894e4ea350423733f4df1687a1019a9 authorpdlla <chippermonky@gmail.com> dateSat 13 Feb 2021, 17:58 (6 years ago) parentdac5ed4
2 files changed+13−8
src-bin/example.hs+1−1 src/Reflex/Vty/Widget/Layout.hs+12−7
src-bin/example.hs+1−1
@@ -230,7 +230,7 @@ todos todos0 newTodo = do
230230 rec tabNav <- tabNavigation
231231 let insertNav = 1 <$ insert
232232 navEv = leftmost [tabNav, insertNav]
233− focusEv = layoutFocusEvFromNavigation navEv lrd
233+ focusEv = layoutFocusEvFromNavigation navEv never lrd
234234 tileCfg = def { _tileConfig_constraint = pure $ Constraint_Fixed 1}
235235 lrd@LayoutReturnData {..} <- flip runIsLayoutVtyWidget focusEv $ runLayoutL (pure Orientation_Column) (Just 0) $
236236 listHoldWithKey todosMap0 updates $ \k t -> tile tileCfg $ do
src/Reflex/Vty/Widget/Layout.hs+12−7
@@ -46,6 +46,7 @@ module Reflex.Vty.Widget.Layout
4646 , LayoutReturnData(..)
4747 ) where
4848
49+
4950import Prelude
5051
5152import Control.Monad.Identity (Identity (..))
@@ -56,6 +57,7 @@ import qualified Data.Bimap as Bimap
5657import Data.Default (Default (..))
5758import qualified Data.Dependent.Map as DMap
5859import Data.Dependent.Sum (DSum ((:=>)))
60+import Data.Functor
5961import Data.Functor.Misc
6062import Data.Map (Map)
6163import qualified Data.Map as Map
@@ -206,18 +208,19 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx
206208
207209 adjustFocus
208210 :: (Bimap Int NodeId)
209− -> Either Int (NodeId, Int) -- left is self index, right is (child id, child index)
211+ -> Either (Maybe Int) (NodeId, Int) -- left is self index, right is (child id, child index)
210212 -> Maybe (Int, (NodeId, Int)) -- fst is self index, snd is (child id, child index)
211− adjustFocus fm (Left ix) = do
213+ adjustFocus fm (Left (Just ix)) = do
212214 x <- findChildFocus fm ix
213215 return (ix, x)
216+ adjustFocus fm (Left Nothing) = Nothing
214217 adjustFocus fm (Right (goto, ixrel)) = do
215218 ix <- Bimap.lookupR goto fm
216219 return (ix+ixrel, (goto, ixrel))
217220
218221 focusChange = attachWith adjustFocus (current focusable)
219222 -- TODO handle Nothing case in both places (so that event produces Nothing in this case)
220− $ leftmost [ fmap Right . fmap getFirst $ focusReq, Left <$> (fmapMaybe id focusReqIx)]
223+ $ leftmost [ fmap Right . fmap getFirst $ focusReq, Left <$> focusReqIx]
221224
222225 let
223226 forestDyn :: Dynamic t [LayoutTree] = join . fmap distributeListOverDyn $ ffor2 queries ddir $ \qs dir -> ffor qs $ \(nid,_,dlt,_) -> translateLayoutTree dir nid solutionMapDyn dlt
@@ -427,12 +430,13 @@ clickable child = LayoutVtyWidget . ReaderT $ \focusEv -> do
427430layoutFocusEvFromNavigation
428431 :: (Reflex t)
429432 => Event t Int
433+ -> Event t ()
430434 -> LayoutReturnData t a
431435 -> Event t (Maybe Int)
432−layoutFocusEvFromNavigation navEv LayoutReturnData {..} = r where
436+layoutFocusEvFromNavigation navEv unfocusEv LayoutReturnData {..} = r where
433437 fmapfn (nKiddos, (mcur, shift)) = maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` nKiddos) mcur
434438 navEv' = attach (current _layoutReturnData_children) $ attach (current _layoutReturnData_focus) navEv
435− r = fmap fmapfn navEv'
439+ r = leftmost [unfocusEv $> Nothing, fmap fmapfn navEv']
436440
437441-- TODO look into making a variant of this function that takes a navigation event
438442-- | Use this variant to begin a layout if you need its "LayoutReturnData"
@@ -445,7 +449,7 @@ beginLayoutL child = mdo
445449 --focussed <- focus
446450 tabEv <- tabNavigation
447451 let
448− focusChildEv = layoutFocusEvFromNavigation tabEv lrd
452+ focusChildEv = layoutFocusEvFromNavigation tabEv never lrd
449453 lrd <- runIsLayoutVtyWidget child focusChildEv
450454 return lrd
451455
@@ -456,6 +460,7 @@ beginLayout
456460 -> VtyWidget t m a
457461beginLayout = fmap _layoutReturnData_value . beginLayoutL
458462
463+
459464{- something like this
460465beginLayoutL
461466 :: (Reflex t, MonadHold t m, MonadFix m)
@@ -467,7 +472,7 @@ beginLayoutL mNavEv child = mdo
467472 --focussed <- focus
468473 let
469474 focusChildEv = case mNavEv of
470− Just navEv -> layoutFocusEvFromNavigation navEv lrd
475+ Just navEv -> layoutFocusEvFromNavigation navEv never lrd
471476 Nothing -> never
472477 lrd <- runIsLayoutVtyWidget child focusChildEv
473478 return lrd