@@ -24,6 +24,12 @@ import Reflex.Vty.Widget
27+-- | Identifies an element that is focusable. Can be created using 'makeFocus'.
28+newtype FocusId = FocusId NodeId
31+-- | An ordered set of focus identifiers. The order here determines the order
32+-- in which focus cycles between focusable elements.
27newtype FocusSet = FocusSet { unFocusSet :: OSet FocusId }
33newtype FocusSet = FocusSet { unFocusSet :: OSet FocusId }
29instance Semigroup FocusSet where
35instance Semigroup FocusSet where
@@ -32,22 +38,28 @@ instance Semigroup FocusSet where
32instance Monoid FocusSet where
38instance Monoid FocusSet where
33 mempty = FocusSet OSet.empty
39 mempty = FocusSet OSet.empty
41+-- | Produces a 'FocusSet' with a single element
35singletonFS :: FocusId -> FocusSet
42singletonFS :: FocusId -> FocusSet
36singletonFS = FocusSet . OSet.singleton
43singletonFS = FocusSet . OSet.singleton
45+-- | Given a 'FocusSet', a currently focused element, and a number of positions
46+-- to move by, determine the newly focused element.
38shiftFS :: FocusSet -> Maybe FocusId -> Int -> Maybe FocusId
47shiftFS :: FocusSet -> Maybe FocusId -> Int -> Maybe FocusId
39shiftFS (FocusSet s) fid n = case OSet.findIndex <$> fid <*> pure s of
48shiftFS (FocusSet s) fid n = case OSet.findIndex <$> fid <*> pure s of
40 Nothing -> OSet.elemAt s 0
49 Nothing -> OSet.elemAt s 0
41 Just Nothing -> OSet.elemAt s 0
50 Just Nothing -> OSet.elemAt s 0
42 Just (Just ix) -> OSet.elemAt s $ mod (ix + n) (OSet.size s)
51 Just (Just ix) -> OSet.elemAt s $ mod (ix + n) (OSet.size s)
53+-- | Operations that change the currently focused element.
44−data Refocus = Refocus_Shift Int
54+data Refocus = Refocus_Shift Int -- ^ Shift the focus by a certain number of positions (see 'shiftFS')
45− | Refocus_Id FocusId
55+ | Refocus_Id FocusId -- ^ Focus a particular element
46− | Refocus_Clear
56+ | Refocus_Clear -- ^ Remove focus from all elements
58+-- | A monad transformer that keeps track of the set of focusable elements and
59+-- which, if any, are currently focused, and allows focus requests.
48newtype Focus t m a = Focus
60newtype Focus t m a = Focus
49 { unFocus :: DynamicWriterT t FocusSet
61 { unFocus :: DynamicWriterT t FocusSet
50− (ReaderT (Dynamic t (Maybe FocusId)) -- TODO Demux?
62+ (ReaderT (Dynamic t (Maybe FocusId))
51 (EventWriterT t (First Refocus) m)) a
63 (EventWriterT t (First Refocus) m)) a
@@ -70,6 +82,7 @@ instance MonadTrans (Focus t) where
70 lift = Focus . lift . lift . lift
82 lift = Focus . lift . lift . lift
72instance (HasVtyInput t m, Monad m) => HasVtyInput t (Focus t m)
84instance (HasVtyInput t m, Monad m) => HasVtyInput t (Focus t m)
73instance (HasVtyWidgetCtx t m, Reflex t, MonadFix m) => HasVtyWidgetCtx t (Focus t m) where
86instance (HasVtyWidgetCtx t m, Reflex t, MonadFix m) => HasVtyWidgetCtx t (Focus t m) where
74 localCtx f g (Focus w) = Focus $ do
87 localCtx f g (Focus w) = Focus $ do
@@ -79,20 +92,24 @@ instance (HasVtyWidgetCtx t m, Reflex t, MonadFix m) => HasVtyWidgetCtx t (Focus
81instance ImageWriter t m => ImageWriter t (Focus t m)
94instance ImageWriter t m => ImageWriter t (Focus t m)
82−instance (HasFocus t m, Monad m) => HasFocus t (Focus t m)
84−newtype FocusId = FocusId NodeId
96+instance (HasFocus t m, Monad m) => HasFocus t (Focus t m)
98+-- | A class for things that can produce focusable elements.
87class (Monad m, Reflex t) => MonadFocus t m | m -> t where
99class (Monad m, Reflex t) => MonadFocus t m | m -> t where
100+ -- | Create a focusable element.
88− focusId :: m FocusId
101+ makeFocus :: m FocusId
102+ -- | Emit an 'Event' of requests to change the focus.
89 requestFocus :: Event t Refocus -> m ()
103 requestFocus :: Event t Refocus -> m ()
104+ -- | Produce a 'Dynamic' that indicates whether the given 'FocusId' is focused.
90 isFocused :: FocusId -> m (Dynamic t Bool)
105 isFocused :: FocusId -> m (Dynamic t Bool)
106+ -- | Run an action, additionally returning the focusable elements it produced.
91 subFoci :: m a -> m (a, Dynamic t FocusSet)
107 subFoci :: m a -> m (a, Dynamic t FocusSet)
108+ -- | Get a 'Dynamic' of the currently focused element identifier.
92 focusedId :: m (Dynamic t (Maybe FocusId))
109 focusedId :: m (Dynamic t (Maybe FocusId))
94instance (Reflex t, MonadFix m, MonadNodeId m) => MonadFocus t (Focus t m) where
111instance (Reflex t, MonadFix m, MonadNodeId m) => MonadFocus t (Focus t m) where
95− focusId = do
112+ makeFocus = do
96 fid <- FocusId <$> lift getNextNodeId
113 fid <- FocusId <$> lift getNextNodeId
97 Focus $ tellDyn $ pure $ singletonFS fid
114 Focus $ tellDyn $ pure $ singletonFS fid
@@ -106,6 +123,7 @@ instance (Reflex t, MonadFix m, MonadNodeId m) => MonadFocus t (Focus t m) where
106 return (a, fs)
123 return (a, fs)
107 focusedId = Focus ask
124 focusedId = Focus ask
126+-- | Runs a 'Focus' action, maintaining the selection state internally.
110 :: (MonadFix m, MonadHold t m, Reflex t)
128 :: (MonadFix m, MonadHold t m, Reflex t)
111 => Focus t m a
129 => Focus t m a
@@ -121,14 +139,17 @@ runFocus (Focus x) = do
121 Refocus_Id fid -> Just fid
139 Refocus_Id fid -> Just fid
122 Refocus_Shift n -> shiftFS fs mf n
140 Refocus_Shift n -> shiftFS fs mf n
142+-- | A widget that is focusable and occupies a layout region based on the
143+-- provided constraint. Returns the 'FocusId' allowing for manual focus
125 :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
146 :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
126 => Dynamic t Constraint
147 => Dynamic t Constraint
128 -> m (FocusId, a)
149 -> m (FocusId, a)
129−tile c w = do
150+tile' c w = do
130− fid <- focusId
151+ fid <- makeFocus
131− r <- leaf c
152+ r <- region c
132 fid' <- focusedId
153 fid' <- focusedId
133 parentFocused <- isFocused fid
154 parentFocused <- isFocused fid
134 rec (click, result, subs) <- pane r focused $ do
155 rec (click, result, subs) <- pane r focused $ do
@@ -142,45 +163,70 @@ tile c w = do
142 requestFocus $ Refocus_Id fid <$ click
163 requestFocus $ Refocus_Id fid <$ click
143 pure (fid, result)
164 pure (fid, result)
145−tile_
166+-- | A widget that is focusable and occupies a layout region based on the
167+-- provided constraint.
146 :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
169 :: (MonadNodeId m, MonadFix m, Reflex t, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
147 => Dynamic t Constraint
170 => Dynamic t Constraint
150−tile_ c = fmap snd . tile c
173+tile c = fmap snd . tile' c
175+-- | A widget that is not focusable and occupies a layout region based on the
176+-- provided constraint.
178+ :: (Reflex t, MonadNodeId m, HasVtyWidgetCtx t m, MonadLayout t m)
179+ => Dynamic t Constraint
184+ pane r (pure False) w
152-- * Layout
186-- * Layout
154−data LTree a = LTree a (LForest a)
188+-- | A collection of information related to the layout of the screen. The root
189+-- node is a "parent" widget, and the contents of the 'LayoutForest' are its
191+data LayoutTree a = LayoutTree a (LayoutForest a)
155 deriving (Show)
192 deriving (Show)
157−newtype LForest a = LForest { unLForest :: OMap NodeId (LTree a) }
194+-- | An ordered, indexed collection of 'LayoutTree's representing information
195+-- about the children of some widget.
196+newtype LayoutForest a = LayoutForest { unLayoutForest :: OMap NodeId (LayoutTree a) }
158 deriving (Show)
197 deriving (Show)
160−instance Semigroup (LForest a) where
199+instance Semigroup (LayoutForest a) where
161− LForest a <> LForest b = LForest $ a OMap.|<> b
200+ LayoutForest a <> LayoutForest b = LayoutForest $ a OMap.|<> b
163−instance Monoid (LForest a) where
202+instance Monoid (LayoutForest a) where
164− mempty = LForest OMap.empty
203+ mempty = LayoutForest OMap.empty
205+-- | Perform a lookup by 'NodeId' in a 'LayoutForest'
166−lookupLF :: NodeId -> LForest a -> Maybe (LTree a)
206+lookupLF :: NodeId -> LayoutForest a -> Maybe (LayoutTree a)
167−lookupLF n (LForest a) = OMap.lookup n a
207+lookupLF n (LayoutForest a) = OMap.lookup n a
209+-- | Create a 'LayoutForest' with one element
169−singletonLF :: NodeId -> LTree a -> LForest a
210+singletonLF :: NodeId -> LayoutTree a -> LayoutForest a
170−singletonLF n t = LForest $ OMap.singleton (n, t)
211+singletonLF n t = LayoutForest $ OMap.singleton (n, t)
213+-- | Produce a 'LayoutForest' from a list. The order of the list is preserved.
172−fromListLF :: [(NodeId, LTree a)] -> LForest a
214+fromListLF :: [(NodeId, LayoutTree a)] -> LayoutForest a
173−fromListLF = LForest . OMap.fromList
215+fromListLF = LayoutForest . OMap.fromList
175−ltreeRoot :: LTree a -> a
217+-- | Extract the information at the root of a 'LayoutTree'
176−ltreeRoot (LTree a _) = a
218+rootLT :: LayoutTree a -> a
219+rootLT (LayoutTree a _) = a
178−ltreeForest :: LTree a -> LForest a
221+-- | Extract the child nodes of a 'LayoutTree'
179−ltreeForest (LTree _ a) = a
222+childrenLT :: LayoutTree a -> LayoutForest a
223+childrenLT (LayoutTree _ a) = a
225+-- | A monad transformer that collects layout constraints and provides a layout
226+-- solution that satisfies those constraints.
181newtype Layout t m a = Layout
227newtype Layout t m a = Layout
182− { unLayout :: DynamicWriterT t (LForest (Constraint, Orientation))
228+ { unLayout :: DynamicWriterT t (LayoutForest (Constraint, Orientation))
183− (ReaderT (Dynamic t (LTree (Region, Orientation))) m) a
229+ (ReaderT (Dynamic t (LayoutTree (Region, Orientation))) m) a
186 ( Functor
232 ( Functor
@@ -204,38 +250,46 @@ instance MonadTrans (Layout t) where
204instance (HasVtyWidgetCtx t m, HasDisplaySize t m, Reflex t, MonadFix m) => HasVtyWidgetCtx t (Layout t m) where
250instance (HasVtyWidgetCtx t m, HasDisplaySize t m, Reflex t, MonadFix m) => HasVtyWidgetCtx t (Layout t m) where
205 localCtx f g x = do
251 localCtx f g x = do
206 solution <- Layout ask
252 solution <- Layout ask
207− let orientation = snd . ltreeRoot <$> solution
253+ let orientation = snd . rootLT <$> solution
208 lift $ localCtx f g $ do
254 lift $ localCtx f g $ do
209 dw <- displayWidth
255 dw <- displayWidth
210 dh <- displayHeight
256 dh <- displayHeight
211− let region = Region 0 0 <$> dw <*> dh
257+ let reg = Region 0 0 <$> dw <*> dh
212− runLayout orientation region x
258+ runLayout orientation reg x
214instance (HasVtyInput t m, Monad m) => HasVtyInput t (Layout t m)
260instance (HasVtyInput t m, Monad m) => HasVtyInput t (Layout t m)
215instance ImageWriter t m => ImageWriter t (Layout t m)
262instance ImageWriter t m => ImageWriter t (Layout t m)
216instance (HasFocus t m, Monad m) => HasFocus t (Layout t m)
264instance (HasFocus t m, Monad m) => HasFocus t (Layout t m)
218−-- TODO Naming: To Has or not to Has?
266+-- | A class of operations for creating screen layouts.
219class Monad m => MonadLayout t m | m -> t where
267class Monad m => MonadLayout t m | m -> t where
268+ -- | Creates a parent element in the current layout with the given size
269+ -- constraint, which lays out its children according to the provided
220 axis :: Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
271 axis :: Dynamic t Orientation -> Dynamic t Constraint -> m a -> m a
272+ -- | Creates a child element in the current layout with the given size
273+ -- constraint, returning the 'Region' that the child element is allocated.
221− leaf :: Dynamic t Constraint -> m (Dynamic t Region)
274+ region :: Dynamic t Constraint -> m (Dynamic t Region)
275+ -- | Returns the orientation of the containing 'axis'.
222 askOrientation :: m (Dynamic t Orientation)
276 askOrientation :: m (Dynamic t Orientation)
224instance (Monad m, MonadNodeId m, Reflex t, MonadFix m) => MonadLayout t (Layout t m) where
278instance (Monad m, MonadNodeId m, Reflex t, MonadFix m) => MonadLayout t (Layout t m) where
225 axis o c (Layout x) = Layout $ do
279 axis o c (Layout x) = Layout $ do
226 nodeId <- getNextNodeId
280 nodeId <- getNextNodeId
227− (result, forest) <- lift $ local (\t -> (\(Just a) -> a) . lookupLF nodeId . ltreeForest <$> t) $ runDynamicWriterT x
281+ (result, forest) <- lift $ local (\t -> (\(Just a) -> a) . lookupLF nodeId . childrenLT <$> t) $ runDynamicWriterT x
228− tellDyn $ singletonLF nodeId <$> (LTree <$> ((,) <$> c <*> o) <*> forest)
282+ tellDyn $ singletonLF nodeId <$> (LayoutTree <$> ((,) <$> c <*> o) <*> forest)
229 pure result
283 pure result
230− leaf c = do
284+ region c = do
231 nodeId <- lift getNextNodeId
285 nodeId <- lift getNextNodeId
232− Layout $ tellDyn $ ffor c $ \c' -> singletonLF nodeId $ LTree (c', Orientation_Row) mempty
286+ Layout $ tellDyn $ ffor c $ \c' -> singletonLF nodeId $ LayoutTree (c', Orientation_Row) mempty
233 solutions <- Layout ask
287 solutions <- Layout ask
234− pure $ maybe (error "leaf: could not find layout solution") (fst . ltreeRoot) . lookupLF nodeId . ltreeForest <$> solutions
288+ pure $ maybe (error "region: could not find layout solution") (fst . rootLT) . lookupLF nodeId . childrenLT <$> solutions
235− askOrientation = Layout $ asks $ fmap (snd . ltreeRoot)
289+ askOrientation = Layout $ asks $ fmap (snd . rootLT)
237instance (MonadFix m, MonadFocus t m) => MonadFocus t (Layout t m) where
291instance (MonadFix m, MonadFocus t m) => MonadFocus t (Layout t m) where
238− focusId = lift focusId
292+ makeFocus = lift makeFocus
239 requestFocus = lift . requestFocus
293 requestFocus = lift . requestFocus
240 isFocused = lift . isFocused
294 isFocused = lift . isFocused
241 focusedId = lift focusedId
295 focusedId = lift focusedId
@@ -255,74 +309,113 @@ data Orientation = Orientation_Column
255 | Orientation_Row
309 | Orientation_Row
256 deriving (Show, Read, Eq, Ord)
310 deriving (Show, Read, Eq, Ord)
258−
312+-- | Create a row-oriented 'axis'
260 :: (Reflex t, MonadNodeId m, MonadFix m, MonadLayout t m)
314 :: (Reflex t, MonadNodeId m, MonadFix m, MonadLayout t m)
263row = axis (pure Orientation_Row) (pure $ Constraint_Min 0)
317row = axis (pure Orientation_Row) (pure $ Constraint_Min 0)
319+-- | Create a column-oriented 'axis'
321+ :: (Reflex t, MonadNodeId m, MonadFix m, MonadLayout t m)
264col = axis (pure Orientation_Column) (pure $ Constraint_Min 0)
324col = axis (pure Orientation_Column) (pure $ Constraint_Min 0)
326+-- | A tile constrained to the given size. Returns the 'FocusId' of the tile,
327+-- allowing for manual focus management.
267 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
329 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
268 => Dynamic t Int
330 => Dynamic t Int
270 -> m (FocusId, a)
332 -> m (FocusId, a)
271−fixed n = tile (Constraint_Fixed <$> n)
333+fixed' n = tile' (Constraint_Fixed <$> n)
273−fixed_
335+-- | A tile constrained to the given size.
274 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
337 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
275 => Dynamic t Int
338 => Dynamic t Int
278−fixed_ n = fmap snd . fixed n
341+fixed n = fmap snd . fixed' n
343+-- | A tile that can grow, but will always occupy at least the given minimum
344+-- size. Returns the 'FocusId' of the tile, allowing for manual focus
281 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
347 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
282 => Dynamic t Int
348 => Dynamic t Int
284 -> m (FocusId, a)
350 -> m (FocusId, a)
285−stretch minSz = tile (Constraint_Min <$> minSz)
351+stretch' minSz = tile' (Constraint_Min <$> minSz)
287−stretch_
353+-- | A tile that can grow, but will always occupy at least the given minimum
288 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
356 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
289 => Dynamic t Int
357 => Dynamic t Int
292−stretch_ minSz = fmap snd . tile (Constraint_Min <$> minSz)
360+stretch minSz = fmap snd . stretch' minSz
362+-- | A tile that can grow or shrink without constraint. Returns the 'FocusId'
363+-- of the tile, allowing for manual focus management.
295 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
365 :: (Reflex t, MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
297 -> m (FocusId, a)
367 -> m (FocusId, a)
298−flex = tile (pure $ Constraint_Min 0)
368+flex' = tile' (pure $ Constraint_Min 0)
300−flex_
370+-- | A tile that can grow or shrink without constraint.
301 :: (Reflex t,MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
372 :: (Reflex t,MonadNodeId m, MonadFix m, HasVtyWidgetCtx t m, HasVtyInput t m, MonadFocus t m, MonadLayout t m)
304−flex_ = fmap snd . flex
375+flex = fmap snd . flex'
306−ltreeConstraint :: LTree (Constraint, a) -> Constraint
307−ltreeConstraint (LTree (c, _) _) = c
377+-- | Produce a layout solution given a starting orientation, the overall screen
378+-- size, and a set of constraints.
310 :: Orientation
380 :: Orientation
311 -> Region
381 -> Region
312− -> LForest (Constraint, Orientation)
382+ -> LayoutForest (Constraint, Orientation)
313− -> LTree (Region, Orientation)
383+ -> LayoutTree (Region, Orientation)
314−solve o0 r0 (LForest cs) =
384+solve o0 r0 (LayoutForest cs) =
315− let a = map (\(x, t) -> ((x, t), ltreeConstraint t)) $ OMap.assocs cs
385+ let a = map (\(x, t@(LayoutTree (c, _) _)) -> ((x, t), c)) $ OMap.assocs cs
316 extent = case o0 of
386 extent = case o0 of
317 Orientation_Row -> _region_width r0
387 Orientation_Row -> _region_width r0
318 Orientation_Column -> _region_height r0
388 Orientation_Column -> _region_height r0
319 sizes = computeEdges $ computeSizes extent a
389 sizes = computeEdges $ computeSizes extent a
320 chunks = [ (nodeId, solve o1 r1 f)
390 chunks = [ (nodeId, solve o1 r1 f)
321− | ((nodeId, LTree (_, o1) f), sz) <- sizes
391+ | ((nodeId, LayoutTree (_, o1) f), sz) <- sizes
322 , let r1 = chunk o0 r0 sz
392 , let r1 = chunk o0 r0 sz
324− in LTree (r0, o0) $ fromListLF chunks
394+ in LayoutTree (r0, o0) $ fromListLF chunks
396+ computeEdges :: [(a, Int)] -> [(a, (Int, Int))]
397+ computeEdges = ($ []) . fst . foldl (\(m, offset) (a, sz) ->
398+ (((a, (offset, sz)) :) . m, sz + offset)) (id, 0)
401+ -> [(a, Constraint)]
403+ computeSizes available constraints =
404+ let minTotal = sum $ ffor constraints $ \case
405+ (_, Constraint_Fixed n) -> n
406+ (_, Constraint_Min n) -> n
407+ leftover = max 0 (available - minTotal)
408+ numStretch = length $ filter (isMin . snd) constraints
409+ szStretch = floor $ leftover % max numStretch 1
410+ adjustment = max 0 $ available - minTotal - szStretch * numStretch
411+ in snd $ mapAccumL (\adj (a, c) -> case c of
412+ Constraint_Fixed n -> (adj, (a, n))
413+ Constraint_Min n -> (0, (a, n + szStretch + adj))) adjustment constraints
414+ isMin (Constraint_Min _) = True
417+-- | Produce a 'Region' given a starting orientation and region, and the offset
418+-- and main-axis size of the chunk.
326chunk :: Orientation -> Region -> (Int, Int) -> Region
419chunk :: Orientation -> Region -> (Int, Int) -> Region
327chunk o r (offset, sz) = case o of
420chunk o r (offset, sz) = case o of
328 Orientation_Column -> r
421 Orientation_Column -> r
@@ -334,30 +427,8 @@ chunk o r (offset, sz) = case o of
334 , _region_width = sz
427 , _region_width = sz
337−-- | Compute the size of each widget "@k@" based on the total set of 'Constraint's
430+-- | Runs a 'Layout' action, using the given orientation and region to
338−computeSizes
431+-- calculate layout solutions.
340− -> [(a, Constraint)]
342−computeSizes available constraints =
343− let minTotal = sum $ ffor constraints $ \case
344− (_, Constraint_Fixed n) -> n
345− (_, Constraint_Min n) -> n
346− leftover = max 0 (available - minTotal)
347− numStretch = length $ filter (isMin . snd) constraints
348− szStretch = floor $ leftover % max numStretch 1
349− adjustment = max 0 $ available - minTotal - szStretch * numStretch
350− in snd $ mapAccumL (\adj (a, c) -> case c of
351− Constraint_Fixed n -> (adj, (a, n))
352− Constraint_Min n -> (0, (a, n + szStretch + adj))) adjustment constraints
354− isMin (Constraint_Min _) = True
357−computeEdges :: [(a, Int)] -> [(a, (Int, Int))]
358−computeEdges = ($ []) . fst . foldl (\(m, offset) (a, sz) ->
359− (((a, (offset, sz)) :) . m, sz + offset)) (id, 0)
362 :: (MonadFix m, Reflex t)
433 :: (MonadFix m, Reflex t)
363 => Dynamic t Orientation
434 => Dynamic t Orientation
@@ -369,6 +440,8 @@ runLayout o r (Layout x) = do
369 let solutions = solve <$> o <*> r <*> w
440 let solutions = solve <$> o <*> r <*> w
370 return result
441 return result
443+-- | Request focus be shifted backward and forward based on tab presses. <Tab>
444+-- shifts focus forward and <Shift+Tab> shifts focus backward.
372tabNavigation :: (Reflex t, MonadNodeId m, HasVtyInput t m, MonadFocus t m) => m ()
445tabNavigation :: (Reflex t, MonadNodeId m, HasVtyInput t m, MonadFocus t m) => m ()
373tabNavigation = do
446tabNavigation = do
374 fwd <- fmap (const 1) <$> key (V.KChar '\t')
447 fwd <- fmap (const 1) <$> key (V.KChar '\t')
@@ -387,25 +460,25 @@ test = mainWidget $ do
387 initManager_ $ do
460 initManager_ $ do
388 tabNavigation
461 tabNavigation
390− fixed_ 5 $ box' $ row $ do
463+ fixed 5 $ box' $ row $ do
391− flex_ $ do
464+ flex $ do
392 text' "asdf"
465 text' "asdf"
393− flex_ $ text' "xyz"
466+ flex $ text' "xyz"
394− fixed_ 5 $ do
467+ fixed 5 $ do
395 text' " 1"
468 text' " 1"
397− tile_ (pure $ Constraint_Min 0) $ do
470+ flex $ do
398 text' "2"
471 text' "2"
399− flex_ $ text' "3"
472+ flex $ text' "3"
400− flex_ $ text' "xyz"
473+ flex $ text' "xyz"
401− flex_ $ text' "xyz"
474+ flex $ text' "xyz"
402− flex_ $ text' "asdf"
475+ flex $ text' "asdf"
403− flex_ $ text' "asdf"
476+ flex $ text' "asdf"
404 return $ fforMaybe inp $ \case
477 return $ fforMaybe inp $ \case
405 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
478 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
406 _ -> Nothing
479 _ -> Nothing
408−-- TODO: 'Manager'? as in "window manager"
481+-- | Initialize a 'Layout' and 'Focus' management context, returning the produced 'FocusSet'.
409initManager
482initManager
410 :: (HasDisplaySize t m, Reflex t, MonadHold t m, MonadFix m)
483 :: (HasDisplaySize t m, Reflex t, MonadHold t m, MonadFix m)
411 => Layout t (Focus t m) a
484 => Layout t (Focus t m) a
@@ -416,6 +489,7 @@ initManager f = do
416 let r = Region 0 0 <$> dw <*> dh
489 let r = Region 0 0 <$> dw <*> dh
417 runFocus $ runLayout (pure Orientation_Column) r f
490 runFocus $ runLayout (pure Orientation_Column) r f
492+-- | Initialize a 'Layout' and 'Focus' management context.
419initManager_
493initManager_
420 :: (HasDisplaySize t m, Reflex t, MonadHold t m, MonadFix m)
494 :: (HasDisplaySize t m, Reflex t, MonadHold t m, MonadFix m)
421 => Layout t (Focus t m) a
495 => Layout t (Focus t m) a