git.iko.soy/reflex-vty
on develop help sign in
Merge remote-tracking branch 'origin/aa/pdlla/layout2' into aa/layout-refactor
96f3d82Ali Abrar
src-bin/example.hs+43−1
compare with develop
unifiedsplit
@@ -8,12 +8,12 @@
8{-# LANGUAGE RecursiveDo #-}
8{-# LANGUAGE RecursiveDo #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ConstraintKinds #-}
10{-# LANGUAGE ConstraintKinds #-}
11−{-# OPTIONS_GHC -threaded #-}
12
11
13import Control.Applicative
12import Control.Applicative
14import Control.Monad
13import Control.Monad
15import Control.Monad.Fix
14import Control.Monad.Fix
16import Control.Monad.NodeId
15import Control.Monad.NodeId
16+import Data.Functor
17import Data.Functor.Misc
17import Data.Functor.Misc
18import Data.Map (Map)
18import Data.Map (Map)
19import qualified Data.Map as Map
19import qualified Data.Map as Map
@@ -45,6 +45,7 @@ type Manager t m =
45data Example = Example_TextEditor
45data Example = Example_TextEditor
46 | Example_Todo
46 | Example_Todo
47 | Example_ScrollableTextDisplay
47 | Example_ScrollableTextDisplay
48+ | Example_ClickButtonsGetEmojis
48 deriving (Show, Read, Eq, Ord, Enum, Bounded)
49 deriving (Show, Read, Eq, Ord, Enum, Bounded)
49
50
50main :: IO ()
51main :: IO ()
@@ -62,10 +63,12 @@ main = mainWidget $ do
62 a <- tf 5 $ textButtonStatic def "Todo List"
63 a <- tf 5 $ textButtonStatic def "Todo List"
63 b <- tf 5 $ textButtonStatic def "Text Editor"
64 b <- tf 5 $ textButtonStatic def "Text Editor"
64 c <- tf 5 $ textButtonStatic def "Scrollable text display"
65 c <- tf 5 $ textButtonStatic def "Scrollable text display"
66+ d <- tf 5 $ textButtonStatic def "Clickable buttons"
65 return $ leftmost
67 return $ leftmost
66 [ Left Example_Todo <$ a
68 [ Left Example_Todo <$ a
67 , Left Example_TextEditor <$ b
69 , Left Example_TextEditor <$ b
68 , Left Example_ScrollableTextDisplay <$ c
70 , Left Example_ScrollableTextDisplay <$ c
71+ , Left Example_ClickButtonsGetEmojis <$ d
69 ]
72 ]
70 let escapable w = do
73 let escapable w = do
71 void w
74 void w
@@ -77,12 +80,51 @@ main = mainWidget $ do
77 Left Example_Todo -> escapable taskList
80 Left Example_Todo -> escapable taskList
78 Left Example_TextEditor -> escapable testBoxes
81 Left Example_TextEditor -> escapable testBoxes
79 Left Example_ScrollableTextDisplay -> escapable scrolling
82 Left Example_ScrollableTextDisplay -> escapable scrolling
83+ Left Example_ClickButtonsGetEmojis -> escapable easyExample
80 Right () -> buttons
84 Right () -> buttons
81 return ()
85 return ()
82 return $ fforMaybe inp $ \case
86 return $ fforMaybe inp $ \case
83 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
87 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
84 _ -> Nothing
88 _ -> Nothing
85
89
90+-- * Mouse button and emojis example
91+easyExample :: (VtyExample t m, Manager t m, MonadHold t m) => m (Event t ())
92+easyExample = do
93+ row $ grout (fixed 39) $ col $ do
94+ (a1,b1,c1) <- grout (fixed 3) $ row $ do
95+ a <- tile flex $ btn "POTATO"
96+ b <- tile flex $ btn "TOMATO"
97+ c <- tile flex $ btn "EGGPLANT"
98+ return (a,b,c)
99+ (a2,b2,c2) <- grout (fixed 3) $ row $ do
100+ a <- tile flex $ btn "CHEESE"
101+ b <- tile flex $ btn "BEES"
102+ c <- tile flex $ btn "MY KNEES"
103+ return (a,b,c)
104+ (a3,b3,c3) <- grout (fixed 3) $ row $ do
105+ a <- tile flex $ btn "TIME"
106+ b <- tile flex $ btn "RHYME"
107+ c <- tile flex $ btn "A BIG CRIME"
108+ return (a,b,c)
109+ tile (fixed 7) $ boxTitle (constant def) "CLICK BUTTONS TO DRAW*" $ do
110+ outputDyn <- foldDyn (<>) "" $ mergeWith (<>)
111+ [a1 $> "\129364", b1 $> "🍅", c1 $> "🍆", a2 $> "\129472", b2 $> "🐝🐝", c2 $> "💘", a3 $> "⏰", b3 $> "📜", c3 $> "💰🔪🔒"]
112+ text (current outputDyn)
113+ tile flex $ text "* Requires font support for emojis. Box may render incorrectly unless your vty is initialized with an updated char width map."
114+ inp <- input
115+ return $ fforMaybe inp $ \case
116+ V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
117+ _ -> Nothing
118+ where
119+ btn label = do
120+ let cfg = def { _buttonConfig_focusStyle = pure doubleBoxStyle }
121+ buttonClick <- textButtonStatic cfg label
122+ keyPress <- keyCombos $ Set.fromList
123+ [ (V.KEnter, [])
124+ , (V.KChar ' ', [])
125+ ]
126+ pure $ leftmost [() <$ buttonClick, () <$ keyPress]
127+
86-- * Task list example
128-- * Task list example
87taskList
129taskList
88 :: (VtyExample t m, Manager t m, MonadHold t m, Adjustable t m, PostBuild t m)
130 :: (VtyExample t m, Manager t m, MonadHold t m, Adjustable t m, PostBuild t m)