@@ -43,6 +43,8 @@ import qualified Graphics.Vty as V
4343import Data.Map.Ordered (OMap)
4444import qualified Data.Map.Ordered as OMap
4545import qualified Graphics.Vty.Attributes as V
46+import Data.Set.Ordered (OSet)
47+import qualified Data.Set.Ordered as OSet
4648
4749import Reflex
4850import Reflex.Host.Class (MonadReflexCreateTrigger)
@@ -50,8 +52,25 @@ import Reflex.Vty.Widget
5052
5153-- * Focus
5254
55+newtype FocusSet = FocusSet { unFocusSet :: OSet FocusId }
56+
57+instance Semigroup FocusSet where
58+ FocusSet a <> FocusSet b = FocusSet $ a OSet.|<> b
59+
60+instance Monoid FocusSet where
61+ mempty = FocusSet OSet.empty
62+
63+singletonFS :: FocusId -> FocusSet
64+singletonFS = FocusSet . OSet.singleton
65+
66+shiftFS :: FocusSet -> Maybe FocusId -> Int -> Maybe FocusId
67+shiftFS (FocusSet s) fid n = case OSet.findIndex <$> fid <*> pure s of
68+ Nothing -> OSet.elemAt s 0
69+ Just Nothing -> OSet.elemAt s 0
70+ Just (Just ix) -> OSet.elemAt s $ mod (ix + n) (OSet.size s)
71+
5372newtype Focus t m a = Focus
54− { unFocus :: DynamicWriterT t (Seq FocusId) (ReaderT (Demux t (Maybe FocusId)) m) a
73+ { unFocus :: DynamicWriterT t FocusSet (ReaderT (Demux t (Maybe FocusId)) m) a
5574 }
5675 deriving
5776 ( Functor
@@ -78,14 +97,14 @@ newtype FocusId = FocusId NodeId
7897focusId :: (MonadNodeId m, Reflex t) => Focus t m FocusId
7998focusId = do
8099 fid <- FocusId <$> lift getNextNodeId
81− Focus $ tellDyn $ pure $ Seq.singleton fid
100+ Focus $ tellDyn $ pure $ singletonFS fid
82101 pure fid
83102
84103runFocus
85104 :: (MonadFix m, MonadHold t m, Reflex t)
86105 => Event t (Maybe FocusId)
87106 -> Focus t m a
88− -> m (a, Dynamic t (Seq FocusId))
107+ -> m (a, Dynamic t FocusSet)
89108runFocus e (Focus x) = do
90109 rec (a, focusIds) <- flip runReaderT (demux sel) $ runDynamicWriterT x
91110 sel <- holdDyn Nothing e
@@ -326,7 +345,7 @@ test = mainWidget $ do
326345 f <- focus
327346 richText (RichTextConfig $ current $ (\x -> if x then V.withStyle V.defAttr V.bold else V.defAttr) <$> f) t
328347 tab <- tabNavigation
329− rec (_, focusSeq) <- runFocus (updated sel) $ runLayout (pure Orientation_Column) r $ do -- TODO start focused
348+ rec (_, focusSet) <- runFocus (updated sel) $ runLayout (pure Orientation_Column) r $ do -- TODO start focused
330349 col (Constraint_Min 0) $ do
331350 tile $ text' "asdf"
332351 tile $ text' "asdf"
@@ -337,8 +356,7 @@ test = mainWidget $ do
337356 tile $ text' "xyz"
338357 tile $ text' "asdf"
339358 tile $ text' "asdf"
340− ix <- foldDyn (+) 0 tab
341− let sel = Seq.lookup <$> (mod <$> ix <*> (Seq.length <$> focusSeq)) <*> focusSeq -- TODO this sucks: when elements are added your focus will shift (OSet)
359+ sel <- holdDyn Nothing $ attachWith (\(fs, s) t -> shiftFS fs s t) (current $ (,) <$> focusSet <*> sel) tab
342360 return $ fforMaybe inp $ \case
343361 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
344362 _ -> Nothing