@@ -8,12 +8,12 @@
88{-# LANGUAGE RecursiveDo #-}
99{-# LANGUAGE ScopedTypeVariables #-}
1010{-# LANGUAGE ConstraintKinds #-}
11−{-# OPTIONS_GHC -threaded #-}
1211
1312import Control.Applicative
1413import Control.Monad
1514import Control.Monad.Fix
1615import Control.Monad.NodeId
16+import Data.Functor
1717import Data.Functor.Misc
1818import Data.Map (Map)
1919import qualified Data.Map as Map
@@ -45,6 +45,7 @@ type Manager t m =
4545data Example = Example_TextEditor
4646 | Example_Todo
4747 | Example_ScrollableTextDisplay
48+ | Example_ClickButtonsGetEmojis
4849 deriving (Show, Read, Eq, Ord, Enum, Bounded)
4950
5051main :: IO ()
@@ -62,10 +63,12 @@ main = mainWidget $ do
6263 a <- tf 5 $ textButtonStatic def "Todo List"
6364 b <- tf 5 $ textButtonStatic def "Text Editor"
6465 c <- tf 5 $ textButtonStatic def "Scrollable text display"
66+ d <- tf 5 $ textButtonStatic def "Clickable buttons"
6567 return $ leftmost
6668 [ Left Example_Todo <$ a
6769 , Left Example_TextEditor <$ b
6870 , Left Example_ScrollableTextDisplay <$ c
71+ , Left Example_ClickButtonsGetEmojis <$ d
6972 ]
7073 let escapable w = do
7174 void w
@@ -77,12 +80,51 @@ main = mainWidget $ do
7780 Left Example_Todo -> escapable taskList
7881 Left Example_TextEditor -> escapable testBoxes
7982 Left Example_ScrollableTextDisplay -> escapable scrolling
83+ Left Example_ClickButtonsGetEmojis -> escapable easyExample
8084 Right () -> buttons
8185 return ()
8286 return $ fforMaybe inp $ \case
8387 V.EvKey (V.KChar 'c') [V.MCtrl] -> Just ()
8488 _ -> Nothing
8589
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+
86128-- * Task list example
87129taskList
88130 :: (VtyExample t m, Manager t m, MonadHold t m, Adjustable t m, PostBuild t m)