6eec462 · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

on develop help sign in

works now

6eec462pdlla6 years ago

src-bin/example.hs+27−24

compare with develop

unifiedsplit

@@ -7,12 +7,16 @@

7{-# LANGUAGE RankNTypes #-}

8{-# LANGUAGE RecursiveDo #-}

9{-# LANGUAGE ScopedTypeVariables #-}

10+{-# LANGUAGE RecordWildCards #-}

11+

12+

10{-# OPTIONS_GHC -threaded #-}

13{-# OPTIONS_GHC -threaded #-}

12import Control.Applicative

15import Control.Applicative

13import Control.Monad

16import Control.Monad

14import Control.Monad.Fix

17import Control.Monad.Fix

15import Control.Monad.NodeId

18import Control.Monad.NodeId

19+import Data.Functor

16import Data.Functor.Misc

20import Data.Functor.Misc

17import Data.Map (Map)

21import Data.Map (Map)

18import Data.Maybe

22import Data.Maybe

@@ -28,30 +32,28 @@ import Reflex.Vty

29easyExample :: IO ()

33easyExample :: IO ()

30easyExample = mainWidget $ do

34easyExample = mainWidget $ do

31− beginLayoutD $ col $ do

35+ beginLayout $ row $ fixedL 39 $ col $ do

32− (a1,b1,c1) <- fixedD 3 $ row $ do

36+ (a1,b1,c1) <- fixedL 3 $ row $ do

33− a <- fixed 15 $ textButtonStatic def "POTATO"

37+ a <- stretch $ textButtonStatic def "POTATO"

34− b <- fixed 15 $ textButtonStatic def "TOMATO"

38+ b <- stretch $ textButtonStatic def "TOMATO"

35− --c <- stretch $ textButtonStatic def "EGGPLANT"

39+ c <- stretch $ textButtonStatic def "EGGPLANT"

36− c <- stretchD $ row $ do

37− stretch $ textButtonStatic def "A"

38− stretch $ textButtonStatic def "B"

39− stretch $ textButtonStatic def "C"

40 return (a,b,c)

41− (a2,b2,c2) <- fixedD 3 $ row $ do

41+ (a2,b2,c2) <- fixedL 3 $ row $ do

42 a <- stretch $ textButtonStatic def "CHEESE"

43 b <- stretch $ textButtonStatic def "BEES"

44− c <- stretch $ textButtonStatic def "ARROW IN MY KNEE"

44+ c <- stretch $ textButtonStatic def "MY KNEES"

45− stretch $ textButtonStatic def "boop"

46− stretch $ textButtonStatic def "doop"

47− stretch $ textButtonStatic def "goop"

48 return (a,b,c)

45 return (a,b,c)

49− (a3,b3,c3) <- fixedD 3 $ row $ do

46+ (a3,b3,c3) <- fixedL 3 $ row $ do

50 a <- stretch $ textButtonStatic def "TIME"

47 a <- stretch $ textButtonStatic def "TIME"

51 b <- stretch $ textButtonStatic def "RHYME"

48 b <- stretch $ textButtonStatic def "RHYME"

52 c <- stretch $ textButtonStatic def "A BIG CRIME"

49 c <- stretch $ textButtonStatic def "A BIG CRIME"

53 return (a,b,c)

50 return (a,b,c)

54− return ()

51+ -- NOTE the box will most likely not render correctly once you put emoji's

52+ -- you need to initialize vty with an updated char width map to fix this

53+ fixed 7 $ boxTitle (constant def) "CLICK BUTTONS TO DRAW" $ do

54+ outputDyn <- foldDyn (<>) "" $ mergeWith (<>)

55+ [a1 $> "\129364", b1 $> "🍅", c1 $> "🍆", a2 $> "\129472", b2 $> "🐝🐝", c2 $> "💘", a3 $> "⏰", b3 $> "📜", c3 $> "💰🔪🔒"]

56+ text (current outputDyn)

55 inp <- input

57 inp <- input

56 return $ fforMaybe inp $ \case

58 return $ fforMaybe inp $ \case

57 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()

59 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()

@@ -66,8 +68,8 @@ data Example = Example_TextEditor

66main :: IO ()

68main :: IO ()

67main = mainWidget $ do

69main = mainWidget $ do

68 inp <- input

70 inp <- input

69− let buttons = col $ do

71+ let buttons = beginLayout $ col $ do

70− fixed 4 $ col $ do

72+ fixedL 4 $ col $ do

71 fixed 1 $ text "Select an example."

73 fixed 1 $ text "Select an example."

72 fixed 1 $ text "Esc will bring you back here."

74 fixed 1 $ text "Esc will bring you back here."

73 fixed 1 $ text "Ctrl+c to quit."

75 fixed 1 $ text "Ctrl+c to quit."

@@ -205,7 +207,7 @@ todo t0 = do

205 _ -> Nothing

207 _ -> Nothing

206

208

207scrolling :: (Reflex t, MonadHold t m, MonadFix m, PostBuild t m, MonadNodeId m) => VtyWidget t m ()

209scrolling :: (Reflex t, MonadHold t m, MonadFix m, PostBuild t m, MonadNodeId m) => VtyWidget t m ()

208−scrolling = col $ do

210+scrolling = beginLayout $ col $ do

209 fixed 2 $ text "Use your mouse wheel or up and down arrows to scroll:"

211 fixed 2 $ text "Use your mouse wheel or up and down arrows to scroll:"

210 out <- fixed 5 $ boxStatic def $ scrollableText never $ "Gallia est omnis divisa in partes tres, quarum unam incolunt Belgae, aliam Aquitani, tertiam qui ipsorum lingua Celtae, nostra Galli appellantur. Hi omnes lingua, institutis, legibus inter se differunt. Gallos ab Aquitanis Garumna flumen, a Belgis Matrona et Sequana dividit. Horum omnium fortissimi sunt Belgae, propterea quod a cultu atque humanitate provinciae longissime absunt, minimeque ad eos mercatores saepe commeant atque ea quae ad effeminandos animos pertinent important, proximique sunt Germanis, qui trans Rhenum incolunt, quibuscum continenter bellum gerunt. Qua de causa Helvetii quoque reliquos Gallos virtute praecedunt, quod fere cotidianis proeliis cum Germanis contendunt, cum aut suis finibus eos prohibent aut ipsi in eorum finibus bellum gerunt. Eorum una pars, quam Gallos obtinere dictum est, initium capit a flumine Rhodano, continetur Garumna flumine, Oceano, finibus Belgarum, attingit etiam ab Sequanis et Helvetiis flumen Rhenum, vergit ad septentriones. Belgae ab extremis Galliae finibus oriuntur, pertinent ad inferiorem partem fluminis Rheni, spectant in septentrionem et orientem solem. Aquitania a Garumna flumine ad Pyrenaeos montes et eam partem Oceani quae est ad Hispaniam pertinet; spectat inter occasum solis et septentriones.\nApud Helvetios longe nobilissimus fuit et ditissimus Orgetorix. Is M. Messala, [et P.] M. Pisone consulibus regni cupiditate inductus coniurationem nobilitatis fecit et civitati persuasit ut de finibus suis cum omnibus copiis exirent: perfacile esse, cum virtute omnibus praestarent, totius Galliae imperio potiri. Id hoc facilius iis persuasit, quod undique loci natura Helvetii continentur: una ex parte flumine Rheno latissimo atque altissimo, qui agrum Helvetium a Germanis dividit; altera ex parte monte Iura altissimo, qui est inter Sequanos et Helvetios; tertia lacu Lemanno et flumine Rhodano, qui provinciam nostram ab Helvetiis dividit. His rebus fiebat ut et minus late vagarentur et minus facile finitimis bellum inferre possent; qua ex parte homines bellandi cupidi magno dolore adficiebantur. Pro multitudine autem hominum et pro gloria belli atque fortitudinis angustos se fines habere arbitrabantur, qui in longitudinem milia passuum CCXL, in latitudinem CLXXX patebant."

212 out <- fixed 5 $ boxStatic def $ scrollableText never $ "Gallia est omnis divisa in partes tres, quarum unam incolunt Belgae, aliam Aquitani, tertiam qui ipsorum lingua Celtae, nostra Galli appellantur. Hi omnes lingua, institutis, legibus inter se differunt. Gallos ab Aquitanis Garumna flumen, a Belgis Matrona et Sequana dividit. Horum omnium fortissimi sunt Belgae, propterea quod a cultu atque humanitate provinciae longissime absunt, minimeque ad eos mercatores saepe commeant atque ea quae ad effeminandos animos pertinent important, proximique sunt Germanis, qui trans Rhenum incolunt, quibuscum continenter bellum gerunt. Qua de causa Helvetii quoque reliquos Gallos virtute praecedunt, quod fere cotidianis proeliis cum Germanis contendunt, cum aut suis finibus eos prohibent aut ipsi in eorum finibus bellum gerunt. Eorum una pars, quam Gallos obtinere dictum est, initium capit a flumine Rhodano, continetur Garumna flumine, Oceano, finibus Belgarum, attingit etiam ab Sequanis et Helvetiis flumen Rhenum, vergit ad septentriones. Belgae ab extremis Galliae finibus oriuntur, pertinent ad inferiorem partem fluminis Rheni, spectant in septentrionem et orientem solem. Aquitania a Garumna flumine ad Pyrenaeos montes et eam partem Oceani quae est ad Hispaniam pertinet; spectat inter occasum solis et septentriones.\nApud Helvetios longe nobilissimus fuit et ditissimus Orgetorix. Is M. Messala, [et P.] M. Pisone consulibus regni cupiditate inductus coniurationem nobilitatis fecit et civitati persuasit ut de finibus suis cum omnibus copiis exirent: perfacile esse, cum virtute omnibus praestarent, totius Galliae imperio potiri. Id hoc facilius iis persuasit, quod undique loci natura Helvetii continentur: una ex parte flumine Rheno latissimo atque altissimo, qui agrum Helvetium a Germanis dividit; altera ex parte monte Iura altissimo, qui est inter Sequanos et Helvetios; tertia lacu Lemanno et flumine Rhodano, qui provinciam nostram ab Helvetiis dividit. His rebus fiebat ut et minus late vagarentur et minus facile finitimis bellum inferre possent; qua ex parte homines bellandi cupidi magno dolore adficiebantur. Pro multitudine autem hominum et pro gloria belli atque fortitudinis angustos se fines habere arbitrabantur, qui in longitudinem milia passuum CCXL, in latitudinem CLXXX patebant."

211 fixed 1 $ text $ ffor out $ \(ix, total) -> "Scrolled to line " <> T.pack (show ix) <> " of " <> T.pack (show total)

213 fixed 1 $ text $ ffor out $ \(ix, total) -> "Scrolled to line " <> T.pack (show ix) <> " of " <> T.pack (show total)

@@ -227,9 +229,10 @@ todos todos0 newTodo = do

227 let todosMap0 = Map.fromList $ zip [0..] todos0

229 let todosMap0 = Map.fromList $ zip [0..] todos0

228 rec tabNav <- tabNavigation

230 rec tabNav <- tabNavigation

229 let insertNav = 1 <$ insert

231 let insertNav = 1 <$ insert

230− nav = 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)

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

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

232− listOut <- runLayout (pure Orientation_Column) 0 nav $

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

233 listHoldWithKey todosMap0 updates $ \k t -> tile tileCfg $ do

236 listHoldWithKey todosMap0 updates $ \k t -> tile tileCfg $ do

234 let sel = select selectOnDelete $ Const2 k

237 let sel = select selectOnDelete $ Const2 k

235 click <- void <$> mouseDown V.BLeft

238 click <- void <$> mouseDown V.BLeft

@@ -240,8 +243,8 @@ todos todos0 newTodo = do

240 let delete = ffor todoDelete $ \k -> Map.singleton k Nothing

243 let delete = ffor todoDelete $ \k -> Map.singleton k Nothing

241 updates = leftmost [insert, delete]

244 updates = leftmost [insert, delete]

242 todoDelete = switch . current $

245 todoDelete = switch . current $

243− leftmost . Map.elems . Map.mapWithKey (\k -> (k <$) . _todoOutput_delete) <$> listOut

246+ leftmost . Map.elems . Map.mapWithKey (\k -> (k <$) . _todoOutput_delete) <$> _layoutReturnData_value

244− todosMap = joinDynThroughMap $ fmap _todoOutput_todo <$> listOut

247+ todosMap = joinDynThroughMap $ fmap _todoOutput_todo <$> _layoutReturnData_value

245 insert = ffor (tag (current todosMap) newTodo) $ \m -> case Map.lookupMax m of

248 insert = ffor (tag (current todosMap) newTodo) $ \m -> case Map.lookupMax m of

246 Nothing -> Map.singleton 0 $ Just $ Todo "" False

249 Nothing -> Map.singleton 0 $ Just $ Todo "" False

247 Just (k, _) -> Map.singleton (k+1) $ Just $ Todo "" False

250 Just (k, _) -> Map.singleton (k+1) $ Just $ Todo "" False

@@ -250,4 +253,4 @@ todos todos0 newTodo = do

250 in fmap fst $ Map.lookupMax before <|> Map.lookupMin after)

253 in fmap fst $ Map.lookupMax before <|> Map.lookupMin after)

251 (current todosMap)

254 (current todosMap)

252 todoDelete

255 todoDelete

253− return listOut

256+ return _layoutReturnData_value

src/Reflex/Vty/Widget/Layout.hs+135−115

@@ -7,59 +7,61 @@

7{-# LANGUAGE RecordWildCards #-}

8{-# LANGUAGE RecursiveDo #-}

9{-# LANGUAGE UndecidableInstances #-}

10+{-# LANGUAGE TypeApplications #-}

11+{-# LANGUAGE RankNTypes #-}

12+{-# LANGUAGE ScopedTypeVariables #-}

12−module Potato.Reflex.Vty.Widget.Layout2

15+module Reflex.Vty.Widget.Layout

13− ( Orientation(..)

16+ ( Orientation(..)

14 , Constraint(..)

17 , Constraint(..)

15 , Layout

18 , Layout

19+ , runLayoutL

16 , runLayout

20 , runLayout

17 , TileConfig(..)

21 , TileConfig(..)

18 , tile

22 , tile

19 , fixed

23 , fixed

20− , fixedD

24+ , fixedL

21 , stretch

25 , stretch

22− , stretchD

26+ , stretchL

23 , col

27 , col

24 , row

28 , row

25− , dummy

29+ , dummyCell

26 , beginLayout

30 , beginLayout

27− , beginLayoutD

31+ , beginLayoutL

28 , tabNavigation

32 , tabNavigation

29 , askOrientation

33 , askOrientation

34+ , LayoutVtyWidget(..)

35+ , LayoutDebugTree(..)

36+ , IsLayoutVtyWidget(..)

37+ , LayoutReturnData(..)

30 ) where

38 ) where

32import Prelude

40import Prelude

34−import qualified Relude as R

35−

36import Control.Monad.Identity (Identity (..))

42import Control.Monad.Identity (Identity (..))

37−import Control.Monad.NodeId (MonadNodeId (..), NodeId (..))

43+import Control.Monad.NodeId (MonadNodeId (..), NodeId)

38import Control.Monad.Reader

44import Control.Monad.Reader

39import Data.Bimap (Bimap)

45import Data.Bimap (Bimap)

40import qualified Data.Bimap as Bimap

46import qualified Data.Bimap as Bimap

41import Data.Default (Default (..))

47import Data.Default (Default (..))

42−import Data.Dependent.Map (DMap, DSum ((:=>)))

43import qualified Data.Dependent.Map as DMap

48import qualified Data.Dependent.Map as DMap

49+import Data.Dependent.Sum (DSum((:=>)))

44import Data.Functor.Misc

50import Data.Functor.Misc

45import Data.Map (Map)

51import Data.Map (Map)

46import qualified Data.Map as Map

52import qualified Data.Map as Map

47import qualified Data.Map.Internal as Map (Map (Bin, Tip))

53import qualified Data.Map.Internal as Map (Map (Bin, Tip))

48−import Data.Maybe (fromMaybe, isJust)

54+import Data.Maybe (fromMaybe)

49import Data.Monoid hiding (First (..))

55import Data.Monoid hiding (First (..))

50import Data.Ratio ((%))

56import Data.Ratio ((%))

51import Data.Semigroup (First (..))

57import Data.Semigroup (First (..))

52import Data.Traversable (mapAccumL)

58import Data.Traversable (mapAccumL)

53−import Data.Tuple.Extra

54import qualified Graphics.Vty as V

59import qualified Graphics.Vty as V

55−import Unsafe.Coerce

57import Reflex

61import Reflex

58import Reflex.Host.Class (MonadReflexCreateTrigger)

62import Reflex.Host.Class (MonadReflexCreateTrigger)

59import Reflex.Vty.Widget

63import Reflex.Vty.Widget

61−import Control.Exception (assert)

62−

63-- | The main-axis orientation of a 'Layout' widget

65-- | The main-axis orientation of a 'Layout' widget

64data Orientation = Orientation_Column

66data Orientation = Orientation_Column

65 | Orientation_Row

67 | Orientation_Row

@@ -80,7 +82,7 @@ data LayoutCtx t = LayoutCtx

81-- | The Layout monad transformer keeps track of the configuration (e.g., 'Orientation') and

83-- | The Layout monad transformer keeps track of the configuration (e.g., 'Orientation') and

82-- 'Constraint's of its child widgets, apportions vty real estate to each, and acts as a

84-- 'Constraint's of its child widgets, apportions vty real estate to each, and acts as a

83−-- switchboard for focus requests. See 'tile' and 'runLayout'.

85+-- switchboard for focus requests. See 'tile_' and 'runLayout'.

84newtype Layout t m a = Layout

86newtype Layout t m a = Layout

85 { unLayout :: EventWriterT t (First (NodeId, Int))

87 { unLayout :: EventWriterT t (First (NodeId, Int))

86 (DynamicWriterT t (Endo [(NodeId, (Bool, Constraint), LayoutDebugTree t, Int)])

88 (DynamicWriterT t (Endo [(NodeId, (Bool, Constraint), LayoutDebugTree t, Int)])

@@ -111,17 +113,16 @@ instance (Adjustable t m, MonadFix m, MonadHold t m) => Adjustable t (Layout t m

111 traverseDMapWithKeyWithAdjust f m e = Layout $ traverseDMapWithKeyWithAdjust (\k v -> unLayout $ f k v) m e

113 traverseDMapWithKeyWithAdjust f m e = Layout $ traverseDMapWithKeyWithAdjust (\k v -> unLayout $ f k v) m e

112 traverseDMapWithKeyWithAdjustWithMove f m e = Layout $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unLayout $ f k v) m e

114 traverseDMapWithKeyWithAdjustWithMove f m e = Layout $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unLayout $ f k v) m e

113

115

114−

115findNearestFloor_ :: (Ord k) => k -> (k, a) -> (k, a) -> Map k a -> Maybe (k, a)

116findNearestFloor_ :: (Ord k) => k -> (k, a) -> (k, a) -> Map k a -> Maybe (k, a)

116−findNearestFloor_ target leftmost parent Map.Tip = if target < fst leftmost

117+findNearestFloor_ target leftValue parent Map.Tip = if target < fst leftValue

117 then Nothing -- error $ "Map.findNearestFloorSure: map has no element <= " <> show target

118 then Nothing -- error $ "Map.findNearestFloorSure: map has no element <= " <> show target

118 else if target < fst parent

119 else if target < fst parent

119− then Just leftmost

120+ then Just leftValue

120 else Just parent

121 else Just parent

121−findNearestFloor_ target leftmost _ (Map.Bin _ k a l r) = if target == k

122+findNearestFloor_ target leftValue _ (Map.Bin _ k a l r) = if target == k

122 then Just (k, a)

123 then Just (k, a)

123 else if target < k

124 else if target < k

124− then findNearestFloor_ target leftmost (k, a) l

125+ then findNearestFloor_ target leftValue (k, a) l

125 else findNearestFloor_ target (k, a) (k, a) r

126 else findNearestFloor_ target (k, a) (k, a) r

126

127

127findNearestFloor :: (Ord k) => k -> Map k a -> Maybe (k,a)

128findNearestFloor :: (Ord k) => k -> Map k a -> Maybe (k,a)

@@ -129,29 +130,27 @@ findNearestFloor _ Map.Tip = Nothing

129-- TODO I don't think we need to do findMin here, just pass in (k,x) as a placeholder value

130-- TODO I don't think we need to do findMin here, just pass in (k,x) as a placeholder value

130findNearestFloor target m@(Map.Bin _ k x _ _) = findNearestFloor_ target (Map.findMin m) (k, x) m

131findNearestFloor target m@(Map.Bin _ k x _ _) = findNearestFloor_ target (Map.findMin m) (k, x) m

131

132

132−

133−

134fanFocusEv :: (Reflex t) => Behavior t (Maybe (NodeId, Int)) -> Event t (Maybe (NodeId, Int)) -> EventSelector t (Const2 NodeId (Maybe Int))

133fanFocusEv :: (Reflex t) => Behavior t (Maybe (NodeId, Int)) -> Event t (Maybe (NodeId, Int)) -> EventSelector t (Const2 NodeId (Maybe Int))

135fanFocusEv focussed focusReqIx = fan $ attachWith attachfn focussed focusReqIx where

134fanFocusEv focussed focusReqIx = fan $ attachWith attachfn focussed focusReqIx where

136 attachfn mkv0 mkv1 = case mkv1 of

135 attachfn mkv0 mkv1 = case mkv1 of

137 Nothing -> case mkv0 of

136 Nothing -> case mkv0 of

138 Nothing -> DMap.empty

137 Nothing -> DMap.empty

139− Just (k0,v0) -> DMap.fromList [Const2 k0 :=> Identity Nothing]

138+ Just (k0,_) -> DMap.fromList [Const2 k0 :=> Identity Nothing]

140 Just (k1,v1) -> case mkv0 of

139 Just (k1,v1) -> case mkv0 of

141 Nothing -> DMap.fromList [Const2 k1 :=> Identity (Just v1)]

140 Nothing -> DMap.fromList [Const2 k1 :=> Identity (Just v1)]

142 Just (k0,v0) | k0 == k1 && v0 == v1 -> DMap.empty

141 Just (k0,v0) | k0 == k1 && v0 == v1 -> DMap.empty

143− Just (k0,v0) | k0 == k1 -> DMap.fromList [Const2 k1 :=> Identity (Just v1)]

142+ Just (k0,_) | k0 == k1 -> DMap.fromList [Const2 k1 :=> Identity (Just v1)]

144− Just (k0,v0) -> DMap.fromList [Const2 k0 :=> Identity Nothing,

143+ Just (k0,_) -> DMap.fromList [Const2 k0 :=> Identity Nothing,

145 Const2 k1 :=> Identity (Just v1)]

144 Const2 k1 :=> Identity (Just v1)]

146

145

147-- | Run a 'Layout' action

146-- | Run a 'Layout' action

148−runLayoutD

147+runLayoutL

149− :: forall t m a. (Reflex t, MonadFix m, MonadHold t m, Monad m, MonadNodeId m)

148+ :: forall t m a. (Reflex t, MonadFix m, MonadHold t m)

150 => Dynamic t Orientation -- ^ The main-axis 'Orientation' of this 'Layout'

149 => Dynamic t Orientation -- ^ The main-axis 'Orientation' of this 'Layout'

151− -> Maybe Int -- ^ The positional index of the initially focused tile

150+ -> Maybe Int -- ^ The positional index of the initially focused tile_

152 -> Layout t m a -- ^ The 'Layout' widget

151 -> Layout t m a -- ^ The 'Layout' widget

153− -> LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a)

152+ -> LayoutVtyWidget t m (LayoutReturnData t a)

154−runLayoutD ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx -> mdo

153+runLayoutL ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx -> mdo

155 dw <- displayWidth

154 dw <- displayWidth

156 dh <- displayHeight

155 dh <- displayHeight

157 let main = ffor3 ddir dw dh $ \d w h -> case d of

156 let main = ffor3 ddir dw dh $ \d w h -> case d of

@@ -228,29 +227,34 @@ runLayoutD ddir mfocus0 (Layout child) = LayoutVtyWidget . ReaderT $ \focusReqIx

228 focusReqWithNodeId = attachWith (\fm mix -> mix >>= \ix -> findChildFocus fm ix) (current focusable) (focusReqIx)

227 focusReqWithNodeId = attachWith (\fm mix -> mix >>= \ix -> findChildFocus fm ix) (current focusable) (focusReqIx)

229 focusChildSelector = fanFocusEv (current $ fmap (fmap snd) focussed) (focusReqWithNodeId)

228 focusChildSelector = fanFocusEv (current $ fmap (fmap snd) focussed) (focusReqWithNodeId)

230

229

230+ return LayoutReturnData {

231− return (emptyLayoutDebugTree, (fmap (fmap fst)) focussed, totalKiddos, a)

231+ _layoutReturnData_tree = emptyLayoutDebugTree

232+ , _layoutReturnData_focus = (fmap (fmap fst)) focussed

233+ , _layoutReturnData_children = totalKiddos

234+ , _layoutReturnData_value = a

235+ }

232

236

233-- | Run a 'Layout' action

237-- | Run a 'Layout' action

234runLayout

238runLayout

235− :: (MonadFix m, MonadHold t m, PostBuild t m, Monad m, MonadNodeId m)

239+ :: forall t m a. (Reflex t, MonadFix m, MonadHold t m, Monad m, MonadNodeId m)

236 => Dynamic t Orientation -- ^ The main-axis 'Orientation' of this 'Layout'

240 => Dynamic t Orientation -- ^ The main-axis 'Orientation' of this 'Layout'

237− -> Maybe Int -- ^ The positional index of the initially focused tile

241+ -> Maybe Int -- ^ The positional index of the initially focused tile_

238 -> Layout t m a -- ^ The 'Layout' widget

242 -> Layout t m a -- ^ The 'Layout' widget

239 -> LayoutVtyWidget t m a

243 -> LayoutVtyWidget t m a

240−runLayout ddir mfocus0 layout = fmap (\(_,_,_,a)->a) $ runLayoutD ddir mfocus0 layout

244+runLayout ddir mfocus0 layout = fmap _layoutReturnData_value $ runLayoutL ddir mfocus0 layout

241

245

242−-- | Tiles are the basic building blocks of 'Layout' widgets. Each tile has a constraint

246+swap :: (a,b) -> (b,a)

243−-- on its size and ability to grow and on whether it can be focused. It also allows its child

247+swap (a,b) = (b,a)

244−-- widget to request focus.

248+

245−tile

249+tile_

246− :: forall t b widget x m a. (Reflex t, IsLayoutReturn t b a, IsLayoutVtyWidget widget t m, Monad m, MonadFix m, MonadNodeId m)

250+ :: forall t b widget m a x. (Reflex t, IsLayoutReturn t b a, IsLayoutVtyWidget widget t m, MonadFix m, MonadNodeId m)

247− => TileConfig t -- ^ The tile's configuration

251+ => TileConfig t -- ^ The tile_'s configuration

248 -> widget t m (Event t x, b) -- ^ A child widget. The 'Event' that it returns is used to request that it be focused.

252 -> widget t m (Event t x, b) -- ^ A child widget. The 'Event' that it returns is used to request that it be focused.

249 -> Layout t m a

253 -> Layout t m a

250−tile (TileConfig con focusable) child = mdo

254+tile_ (TileConfig con focusable) child = mdo

251 nodeId <- getNextNodeId

255 nodeId <- getNextNodeId

252 -- by calling getLayoutTree/getLayoutNumChildren here, we store the children's layout info inside the DynamicWriter

256 -- by calling getLayoutTree/getLayoutNumChildren here, we store the children's layout info inside the DynamicWriter

253− -- runLayoutD will extract this info later

257+ -- runLayoutL will extract this info later

254 Layout $ tellDyn $ ffor2 con focusable $ \c f -> Endo ((nodeId, (f, c), getLayoutTree @t @b @a b, nKiddos):)

258 Layout $ tellDyn $ ffor2 con focusable $ \c f -> Endo ((nodeId, (f, c), getLayoutTree @t @b @a b, nKiddos):)

255 seg <- Layout $ asks $

259 seg <- Layout $ asks $

256 fmap (Map.findWithDefault (LayoutSegment 0 0) nodeId) . _layoutCtx_regions

260 fmap (Map.findWithDefault (LayoutSegment 0 0) nodeId) . _layoutCtx_regions

@@ -286,80 +290,95 @@ tile (TileConfig con focusable) child = mdo

286 else never

290 else never

287 return $ getLayoutResult @t b

291 return $ getLayoutResult @t b

288

292

293+-- | Tiles are the basic building blocks of 'Layout' widgets. Each tile has a constraint

294+-- on its size and ability to grow and on whether it can be focused. It also allows its child

295+-- widget to request focus.

296+tile

297+ :: (Reflex t, IsLayoutVtyWidget widget t m, MonadFix m, MonadNodeId m)

298+ => TileConfig t -- ^ The tile's configuration

299+ -> widget t m (Event t x, a) -- ^ A child widget. The 'Event' that it returns is used to request that it be focused.

300+ -> Layout t m a

301+tile = tile_

302+

289

303

290−-- | Configuration options for and constraints on 'tile'

304+-- | Configuration options for and constraints on 'tile_'

291data TileConfig t = TileConfig

305data TileConfig t = TileConfig

292 { _tileConfig_constraint :: Dynamic t Constraint

306 { _tileConfig_constraint :: Dynamic t Constraint

293− -- ^ 'Constraint' on the tile's size

307+ -- ^ 'Constraint' on the tile_'s size

294− , _tileConfig_focusable :: Dynamic t Bool

308+ , _tile_Config_focusable :: Dynamic t Bool

295− -- ^ Whether the tile is focusable

309+ -- ^ Whether the tile_ is focusable

296 }

310 }

297

311

298−

299instance Reflex t => Default (TileConfig t) where

312instance Reflex t => Default (TileConfig t) where

300 def = TileConfig (pure $ Constraint_Min 0) (pure True)

313 def = TileConfig (pure $ Constraint_Min 0) (pure True)

301

314

302−-- | A 'tile' of a fixed size that is focusable and gains focus on click

315+

303−fixed'

316+fixed_

304− :: (Reflex t, IsLayoutReturn t b a, IsLayoutVtyWidget widget t m, Monad m, MonadFix m, MonadNodeId m)

317+ :: (Reflex t, IsLayoutReturn t b a, IsLayoutVtyWidget widget t m, MonadFix m, MonadNodeId m)

305 => Dynamic t Int

318 => Dynamic t Int

306 -> widget t m b

319 -> widget t m b

307 -> Layout t m a

320 -> Layout t m a

308−fixed' sz = tile (def { _tileConfig_constraint = Constraint_Fixed <$> sz }) . clickable

321+fixed_ sz = tile_ (def { _tileConfig_constraint = Constraint_Fixed <$> sz }) . clickable

309

322

310−fixedD

323+-- | Use this variant to start a sub layout.

324+fixedL

311− :: (Reflex t, Monad m, MonadFix m, MonadNodeId m)

325+ :: (Reflex t, MonadFix m, MonadNodeId m)

312 => Dynamic t Int

326 => Dynamic t Int

313− -> LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a)

327+ -> LayoutVtyWidget t m (LayoutReturnData t a)

314 -> Layout t m a

328 -> Layout t m a

315−fixedD = fixed'

329+fixedL = fixed_

316

330

331+-- | A 'tile' of a fixed size that is focusable and gains focus on click

317fixed

332fixed

318− :: (Reflex t, IsLayoutVtyWidget widget t m, Monad m, MonadFix m, MonadNodeId m)

333+ :: (Reflex t, MonadFix m, MonadNodeId m)

319 => Dynamic t Int

334 => Dynamic t Int

320− -> widget t m a

335+ -> VtyWidget t m a

321 -> Layout t m a

336 -> Layout t m a

322−fixed = fixed'

337+fixed = fixed_

323

338

324−-- | A 'tile' that can stretch (i.e., has no fixed size) and has a minimum size of 0.

339+stretch_

325−-- This tile is focusable and gains focus on click.

326−stretch'

327− :: (Reflex t, IsLayoutReturn t b a, IsLayoutVtyWidget widget t m, Monad m, MonadFix m, MonadNodeId m)

340+ :: (Reflex t, IsLayoutReturn t b a, IsLayoutVtyWidget widget t m, MonadFix m, MonadNodeId m)

328 => widget t m b

341 => widget t m b

329 -> Layout t m a

342 -> Layout t m a

330−stretch' = tile def . clickable

343+stretch_ = tile_ def . clickable

331

344

332−stretchD

345+-- | Use this variant to start a sub layout.

346+stretchL

333− :: (Reflex t, Monad m, MonadFix m, MonadNodeId m)

347+ :: (Reflex t, MonadFix m, MonadNodeId m)

334− => LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a)

348+ => LayoutVtyWidget t m (LayoutReturnData t a)

335 -> Layout t m a

349 -> Layout t m a

336−stretchD = stretch'

350+stretchL = stretch_

337

351

352+-- | A 'tile' that can stretch (i.e., has no fixed size) and has a minimum size of 0.

353+-- This tile is focusable and gains focus on click.

338stretch

354stretch

339− :: (Reflex t, IsLayoutVtyWidget widget t m, Monad m, MonadFix m, MonadNodeId m)

355+ :: (Reflex t, MonadFix m, MonadNodeId m)

340− => widget t m a

356+ => VtyWidget t m a

341 -> Layout t m a

357 -> Layout t m a

342−stretch = stretch'

358+stretch = stretch_

343

359

344−-- | A version of 'runLayout' that arranges tiles in a column and uses 'tabNavigation' to

360+-- | A version of 'runLayout' that arranges tiles in a column

345−-- change tile focus.

346col

361col

347− :: (MonadFix m, MonadHold t m, PostBuild t m, MonadNodeId m)

362+ :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)

348 => Layout t m a

363 => Layout t m a

349− -> LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a)

364+ -> LayoutVtyWidget t m (LayoutReturnData t a)

350−col child = runLayoutD (pure Orientation_Column) (Just 0) child

365+col child = runLayoutL (pure Orientation_Column) (Just 0) child

351

366

352−-- | A version of 'runLayout' that arranges tiles in a row and uses 'tabNavigation' to

367+-- | A version of 'runLayout' that arranges tiles in a row

353−-- change tile focus.

354row

368row

355− :: (MonadFix m, MonadHold t m, PostBuild t m, MonadNodeId m)

369+ :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m)

356 => Layout t m a

370 => Layout t m a

357− -> LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a)

371+ -> LayoutVtyWidget t m (LayoutReturnData t a)

358−row child = runLayoutD (pure Orientation_Row) (Just 0) child

372+row child = runLayoutL (pure Orientation_Row) (Just 0) child

359−

373+

360−-- | Testing placeholder DELETE

374+-- | Use to make placeholder empty cells in sub layouts.

361−dummy :: (Reflex t, Monad m) => LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, ())

375+dummyCell :: (Reflex t, Monad m) => LayoutVtyWidget t m (LayoutReturnData t ())

376+dummyCell = return LayoutReturnData {

362−dummy = return (emptyLayoutDebugTree, constDyn Nothing, 0, ())

377+ _layoutReturnData_tree = emptyLayoutDebugTree

378+ , _layoutReturnData_focus = constDyn Nothing

379+ , _layoutReturnData_children = 0

380+ , _layoutReturnData_value = ()

381+ }

363

382

364-- | Produces an 'Event' that navigates forward one tile when the Tab key is pressed

383-- | Produces an 'Event' that navigates forward one tile when the Tab key is pressed

365-- and backward one tile when Shift+Tab is pressed.

384-- and backward one tile when Shift+Tab is pressed.

@@ -380,24 +399,26 @@ clickable child = LayoutVtyWidget . ReaderT $ \focusEv -> do

380 a <- runIsLayoutVtyWidget child focusEv

399 a <- runIsLayoutVtyWidget child focusEv

381 return (() <$ click, a)

400 return (() <$ click, a)

382

401

383−beginLayoutD ::

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

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

404+beginLayoutL

384− forall m t a. (MonadHold t m, PostBuild t m, MonadFix m, MonadNodeId m)

405+ :: (Reflex t, MonadHold t m, MonadFix m)

385− => LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a)

406+ => LayoutVtyWidget t m (LayoutReturnData t a)

386− -> VtyWidget t m (LayoutDebugTree t, a)

407+ -> VtyWidget t m (LayoutReturnData t a)

387−beginLayoutD child = mdo

408+beginLayoutL child = mdo

388 -- TODO consider unfocusing if this loses focus

409 -- TODO consider unfocusing if this loses focus

389 --focussed <- focus

410 --focussed <- focus

390 tabEv <- tabNavigation

411 tabEv <- tabNavigation

391− let focusChildEv = fmap (\(mcur, shift) -> maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` totalKiddos) mcur) (attach (current indexDyn) tabEv)

412+ let focusChildEv = fmap (\(mcur, shift) -> maybe (Just 0) (\cur -> Just $ (shift + cur) `mod` _layoutReturnData_children) mcur) (attach (current _layoutReturnData_focus) tabEv)

392− (ldt, indexDyn, totalKiddos, a) <- runIsLayoutVtyWidget child focusChildEv

413+ lrd@LayoutReturnData{..} <- runIsLayoutVtyWidget child focusChildEv

393− return (ldt, a)

414+ return lrd

394−

415+

395−-- |

416+-- | Begin a layout using tab and shift-tab to navigate

396−beginLayout ::

417+beginLayout

397− forall m t b a. (MonadHold t m, PostBuild t m, MonadFix m, MonadNodeId m)

418+ :: (Reflex t, MonadHold t m, MonadFix m, MonadNodeId m)

398− => LayoutVtyWidget t m (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a)

419+ => LayoutVtyWidget t m (LayoutReturnData t a)

399 -> VtyWidget t m a

420 -> VtyWidget t m a

400−beginLayout = fmap snd . beginLayoutD

421+beginLayout = fmap _layoutReturnData_value . beginLayoutL

401

422

402-- | Retrieve the current orientation of a 'Layout'

423-- | Retrieve the current orientation of a 'Layout'

403askOrientation :: Monad m => Layout t m (Dynamic t Orientation)

424askOrientation :: Monad m => Layout t m (Dynamic t Orientation)

@@ -410,8 +431,7 @@ data Constraint = Constraint_Fixed Int

410

431

411-- | Compute the size of each widget "@k@" based on the total set of 'Constraint's

432-- | Compute the size of each widget "@k@" based on the total set of 'Constraint's

412computeSizes

433computeSizes

413− :: Ord k

414− => Int

434+ :: Int

415 -> Map k (a, Constraint)

435 -> Map k (a, Constraint)

416 -> Map k (a, Int)

436 -> Map k (a, Int)

417computeSizes available constraints =

437computeSizes available constraints =

@@ -433,15 +453,9 @@ computeEdges :: (Ord k) => Map k (a, Int) -> Map k (a, (Int, Int))

433computeEdges = fst . Map.foldlWithKey' (\(m, offset) k (a, sz) ->

453computeEdges = fst . Map.foldlWithKey' (\(m, offset) k (a, sz) ->

434 (Map.insert k (a, (offset, sz)) m, sz + offset)) (Map.empty, 0)

454 (Map.insert k (a, (offset, sz)) m, sz + offset)) (Map.empty, 0)

435

455

436−

456+-- TODO FINISH

437−

438−

439−

440−

441−

442−

443−-- TODO should prob be (Branch [LayoutDebugTree] | Leaf PosDim

444-- but it's weird cuz a leaf node won't know it's PosDim until combined with a Region...

457-- but it's weird cuz a leaf node won't know it's PosDim until combined with a Region...

458+-- | Dynamic sizing information on a layout hierarchy (intended for testing)

445data LayoutDebugTree t = LayoutDebugTree_Branch [LayoutDebugTree t] | LayoutDebugTree_Leaf

459data LayoutDebugTree t = LayoutDebugTree_Branch [LayoutDebugTree t] | LayoutDebugTree_Leaf

446

460

447emptyLayoutDebugTree :: LayoutDebugTree t

461emptyLayoutDebugTree :: LayoutDebugTree t

@@ -453,12 +467,18 @@ class IsLayoutReturn t b a where

453 getLayoutFocussedDyn :: b -> Dynamic t (Maybe Int)

467 getLayoutFocussedDyn :: b -> Dynamic t (Maybe Int)

454 getLayoutTree :: b -> LayoutDebugTree t

468 getLayoutTree :: b -> LayoutDebugTree t

455

469

470+data LayoutReturnData t a = LayoutReturnData {

471+ _layoutReturnData_tree :: LayoutDebugTree t

472+ , _layoutReturnData_focus :: Dynamic t (Maybe Int)

473+ , _layoutReturnData_children :: Int

474+ , _layoutReturnData_value :: a

475+ }

456

476

457−instance IsLayoutReturn t (LayoutDebugTree t, Dynamic t (Maybe Int), Int, a) a where

477+instance IsLayoutReturn t (LayoutReturnData t a) a where

458− getLayoutResult (_,_,_,a) = a

478+ getLayoutResult lrd = _layoutReturnData_value lrd

459− getLayoutNumChildren (_,_,d,_) = d

479+ getLayoutNumChildren lrd = _layoutReturnData_children lrd

460− getLayoutFocussedDyn (_,d,_,_) = d

480+ getLayoutFocussedDyn lrd = _layoutReturnData_focus lrd

461− getLayoutTree (tree,_,_,_) = tree

481+ getLayoutTree lrd = _layoutReturnData_tree lrd

462

482

463instance Reflex t => IsLayoutReturn t a a where

483instance Reflex t => IsLayoutReturn t a a where

464 getLayoutResult = id

484 getLayoutResult = id

@@ -466,7 +486,7 @@ instance Reflex t => IsLayoutReturn t a a where

466 getLayoutFocussedDyn _ = constDyn Nothing

486 getLayoutFocussedDyn _ = constDyn Nothing

467 getLayoutTree _ = emptyLayoutDebugTree

487 getLayoutTree _ = emptyLayoutDebugTree

468

488

469−class IsLayoutVtyWidget l t (m :: * -> *) where

489+class IsLayoutVtyWidget l t m where

470 runIsLayoutVtyWidget :: l t m a -> Event t (Maybe Int) -> VtyWidget t m a

490 runIsLayoutVtyWidget :: l t m a -> Event t (Maybe Int) -> VtyWidget t m a

471

491

472newtype LayoutVtyWidget t m a = LayoutVtyWidget {

492newtype LayoutVtyWidget t m a = LayoutVtyWidget {