@@ -7,6 +7,7 @@
77{-# LANGUAGE RankNTypes #-}
88{-# LANGUAGE RecursiveDo #-}
99{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE ConstraintKinds #-}
1011{-# OPTIONS_GHC -threaded #-}
1112
1213import Control.Applicative
@@ -15,17 +16,28 @@ import Control.Monad.Fix
1516import Control.Monad.NodeId
1617import Data.Functor.Misc
1718import Data.Map (Map)
18−import Data.Maybe
1919import qualified Data.Map as Map
20+import Data.Maybe
2021import Data.Text (Text)
2122import qualified Data.Text as T
2223import qualified Data.Text.Zipper as TZ
2324import qualified Graphics.Vty as V
2425import Reflex
25−import Reflex.Network
2626import Reflex.Class.Switchable
27+import Reflex.Network
2728import Reflex.Vty
2829
30+type VtyExample t m =
31+ ( MonadFix m
32+ , Reflex t
33+ , HasVtyInput t m
34+ , HasVtyWidgetCtx t m
35+ , ImageWriter t m
36+ , MonadNodeId m
37+ , HasDisplaySize t m
38+ , HasFocus t m
39+ )
40+
2941data Example = Example_TextEditor
3042 | Example_Todo
3143 | Example_ScrollableTextDisplay
@@ -34,34 +46,40 @@ data Example = Example_TextEditor
3446main :: IO ()
3547main = mainWidget $ do
3648 inp <- input
37− let buttons = col $ do
38− fixed 4 $ col $ do
39− fixed 1 $ text "Select an example."
40− fixed 1 $ text "Esc will bring you back here."
41− fixed 1 $ text "Ctrl+c to quit."
42− a <- fixed 5 $ textButtonStatic def "Todo List"
43− b <- fixed 5 $ textButtonStatic def "Text Editor"
44− c <- fixed 5 $ textButtonStatic def "Scrollable text display"
45− return $ leftmost
46− [ Left Example_Todo <$ a
47− , Left Example_TextEditor <$ b
48− , Left Example_ScrollableTextDisplay <$ c
49− ]
50− escapable w = do
51− void w
52− i <- input
53− return $ fforMaybe i $ \case
54− V.EvKey V.KEsc [] -> Just $ Right ()
55− _ -> Nothing
56− rec out <- networkHold buttons $ ffor (switch (current out)) $ \case
57− Left Example_TextEditor -> escapable testBoxes
58− Left Example_Todo -> escapable taskList
59− Left Example_ScrollableTextDisplay -> escapable scrolling
60− Right () -> buttons
49+ initManager_ $ do
50+ tabNavigation
51+ let gf = grout . fixed
52+ tf = tile . fixed
53+ buttons = col $ do
54+ gf 4 $ col $ do
55+ gf 1 $ text "Select an example."
56+ gf 1 $ text "Esc will bring you back here."
57+ gf 1 $ text "Ctrl+c to quit."
58+ a <- tf 5 $ textButtonStatic def "Todo List"
59+ b <- tf 5 $ textButtonStatic def "Text Editor"
60+ c <- tf 5 $ textButtonStatic def "Scrollable text display"
61+ return $ leftmost
62+ [ Left Example_Todo <$ a
63+ , Left Example_TextEditor <$ b
64+ , Left Example_ScrollableTextDisplay <$ c
65+ ]
66+ let escapable w = do
67+ void w
68+ i <- input
69+ return $ fforMaybe i $ \case
70+ V.EvKey V.KEsc [] -> Just $ Right ()
71+ _ -> Nothing
72+ rec out <- networkHold buttons $ ffor (switch (current out)) $ \case
73+ Left Example_Todo -> escapable blank -- taskList
74+ Left Example_TextEditor -> escapable testBoxes
75+ Left Example_ScrollableTextDisplay -> escapable blank -- scrolling
76+ Right () -> buttons
77+ return ()
6178 return $ fforMaybe inp $ \case
6279 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
6380 _ -> Nothing
6481
82+ {-
6583taskList
6684 :: (Reflex t, MonadHold t m, MonadFix m, Adjustable t m, NotReady t m, PostBuild t m, MonadNodeId m)
6785 => VtyWidget t m ()
@@ -82,15 +100,17 @@ taskList = do
82100 (m, (e, _)) <- splitV (pure (subtract 6)) (pure (True, True)) todos' $
83101 splitV (pure (subtract 3)) (pure (True, True)) btn (display $ Map.size <$> current m)
84102 return ()
103+-}
104+
85105
86106testBoxes
87− :: (Reflex t, MonadHold t m, MonadFix m, MonadNodeId m)
88− => VtyWidget t m ()
107+ :: (MonadHold t m, MonadNodeId m, VtyExample t m)
108+ => m ()
89109testBoxes = do
90110 dw <- displayWidth
91111 dh <- displayHeight
92− let region1 = DynRegion (div' dw 6) (div' dh 6) (div' dw 2) (div' dh 2)
93− region2 = DynRegion (div' dw 4) (div' dh 4) (2 * div' dw 3) (2 * div' dh 3)
112+ let region1 = Region <$> (div' dw 6) <*> (div' dh 6) <*> (div' dw 2) <*> (div' dh 2)
113+ region2 = Region <$> (div' dw 4) <*> (div' dh 4) <*> (2 * div' dw 3) <*> (2 * div' dh 3)
94114 pane region1 (constDyn False) . boxStatic singleBoxStyle $ debugInput
95115 _ <- pane region2 (constDyn True) . boxStatic singleBoxStyle $
96116 let cfg = def
@@ -106,25 +126,26 @@ testBoxes = do
106126 div' :: (Integral a, Applicative f) => f a -> f a -> f a
107127 div' = liftA2 div
108128
109−debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()
129+debugFocus :: (VtyExample t m) => m ()
110130debugFocus = do
111131 f <- focus
112132 text $ T.pack . show <$> current f
113133
114−debugInput :: (Reflex t, MonadHold t m) => VtyWidget t m ()
134+debugInput :: (VtyExample t m, MonadHold t m) => m ()
115135debugInput = do
116136 lastEvent <- hold "No event yet" . fmap show =<< input
117137 text $ T.pack <$> lastEvent
118138
119−dragTest :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()
139+dragTest :: (VtyExample t m, MonadHold t m) => m ()
120140dragTest = do
121141 lastEvent <- hold "No event yet" . fmap show =<< drag V.BLeft
122142 text $ T.pack <$> lastEvent
123143
124−testStringBox :: (Reflex t, Monad m, MonadNodeId m) => VtyWidget t m ()
144+testStringBox :: VtyExample t m => m ()
125145testStringBox = boxStatic singleBoxStyle .
126146 text . pure . T.pack . take 500 $ cycle ('\n' : ['a'..'z'])
127147
148+{-
128149data Todo = Todo
129150 { _todo_label :: Text
130151 , _todo_done :: Bool
@@ -219,3 +240,4 @@ todos todos0 newTodo = do
219240 (current todosMap)
220241 todoDelete
221242 return listOut
243+-}