ed239d3 · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

on develop help sign in

fix unfocus behavior in layout

ed239d3pdlla6 years ago

src-bin/example.hs+1−1

compare with develop

unifiedsplit

@@ -230,7 +230,7 @@ todos todos0 newTodo = do

230 rec tabNav <- tabNavigation

231 let insertNav = 1 <$ insert

232 navEv = leftmost [tabNav, insertNav]

233− focusEv = layoutFocusEvFromNavigation navEv lrd

233+ focusEv = layoutFocusEvFromNavigation navEv never lrd

234 tileCfg = def { _tileConfig_constraint = pure $ Constraint_Fixed 1}

235 lrd@LayoutReturnData {..} <- flip runIsLayoutVtyWidget focusEv $ runLayoutL (pure Orientation_Column) (Just 0) $

236 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

46 , LayoutReturnData(..)

47 ) where

49+

49import Prelude

50import Prelude

51import Control.Monad.Identity (Identity (..))

52import Control.Monad.Identity (Identity (..))

@@ -56,6 +57,7 @@ import qualified Data.Bimap as Bimap

56import Data.Default (Default (..))

57import Data.Default (Default (..))

57import qualified Data.Dependent.Map as DMap

58import qualified Data.Dependent.Map as DMap

58import Data.Dependent.Sum (DSum ((:=>)))

59import Data.Dependent.Sum (DSum ((:=>)))

60+import Data.Functor

59import Data.Functor.Misc

61import Data.Functor.Misc

60import Data.Map (Map)

62import Data.Map (Map)

61import qualified Data.Map as Map

63import qualified Data.Map as Map

@@ -206,18 +208,19 @@ runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx

206

208

207 adjustFocus

209 adjustFocus

208 :: (Bimap Int NodeId)

210 :: (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)

210 -> Maybe (Int, (NodeId, Int)) -- fst is self index, snd is (child id, child index)

212 -> 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

212 x <- findChildFocus fm ix

214 x <- findChildFocus fm ix

213 return (ix, x)

215 return (ix, x)

216+ adjustFocus fm (Left Nothing) = Nothing

214 adjustFocus fm (Right (goto, ixrel)) = do

217 adjustFocus fm (Right (goto, ixrel)) = do

215 ix <- Bimap.lookupR goto fm

218 ix <- Bimap.lookupR goto fm

216 return (ix+ixrel, (goto, ixrel))

219 return (ix+ixrel, (goto, ixrel))

217

220

218 focusChange = attachWith adjustFocus (current focusable)

221 focusChange = attachWith adjustFocus (current focusable)

219 -- TODO handle Nothing case in both places (so that event produces Nothing in this case)

222 -- 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]

221

224

222 let

225 let

223 forestDyn :: Dynamic t [LayoutTree] = join . fmap distributeListOverDyn $ ffor2 queries ddir $ \qs dir -> ffor qs $ \(nid,_,dlt,_) -> translateLayoutTree dir nid solutionMapDyn dlt

226 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

427layoutFocusEvFromNavigation

430layoutFocusEvFromNavigation

428 :: (Reflex t)

431 :: (Reflex t)

429 => Event t Int

432 => Event t Int

433+ -> Event t ()

430 -> LayoutReturnData t a

434 -> LayoutReturnData t a

431 -> Event t (Maybe Int)

435 -> Event t (Maybe Int)

432−layoutFocusEvFromNavigation navEv LayoutReturnData {..} = r where

436+layoutFocusEvFromNavigation navEv unfocusEv LayoutReturnData {..} = r where

433 fmapfn (nKiddos, (mcur, shift)) = maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` nKiddos) mcur

437 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

438 navEv' = attach (current _layoutReturnData_children) $ attach (current _layoutReturnData_focus) navEv

435− r = fmap fmapfn navEv'

439+ r = leftmost [unfocusEv $> Nothing, fmap fmapfn navEv']

436

440

437-- TODO look into making a variant of this function that takes a navigation event

441-- TODO look into making a variant of this function that takes a navigation event

438-- | Use this variant to begin a layout if you need its "LayoutReturnData"

442-- | Use this variant to begin a layout if you need its "LayoutReturnData"

@@ -445,7 +449,7 @@ beginLayoutL child = mdo

445 --focussed <- focus

449 --focussed <- focus

446 tabEv <- tabNavigation

450 tabEv <- tabNavigation

447 let

451 let

448− focusChildEv = layoutFocusEvFromNavigation tabEv lrd

452+ focusChildEv = layoutFocusEvFromNavigation tabEv never lrd

449 lrd <- runIsLayoutVtyWidget child focusChildEv

453 lrd <- runIsLayoutVtyWidget child focusChildEv

450 return lrd

454 return lrd

451

455

@@ -456,6 +460,7 @@ beginLayout

456 -> VtyWidget t m a

460 -> VtyWidget t m a

457beginLayout = fmap _layoutReturnData_value . beginLayoutL

461beginLayout = fmap _layoutReturnData_value . beginLayoutL

458

462

463+

459{- something like this

464{- something like this

460beginLayoutL

465beginLayoutL

461 :: (Reflex t, MonadHold t m, MonadFix m)

466 :: (Reflex t, MonadHold t m, MonadFix m)

@@ -467,7 +472,7 @@ beginLayoutL mNavEv child = mdo

467 --focussed <- focus

472 --focussed <- focus

468 let

473 let

469 focusChildEv = case mNavEv of

474 focusChildEv = case mNavEv of

470− Just navEv -> layoutFocusEvFromNavigation navEv lrd

475+ Just navEv -> layoutFocusEvFromNavigation navEv never lrd

471 Nothing -> never

476 Nothing -> never

472 lrd <- runIsLayoutVtyWidget child focusChildEv

477 lrd <- runIsLayoutVtyWidget child focusChildEv

473 return lrd

478 return lrd