git.iko.soy/reflex-vty
on develop help sign in
Add some button widgets and a rich-text widget
ed6ffffAli Abrar
src-bin/example.hs+3−8
compare with develop
unifiedsplit
@@ -41,8 +41,8 @@ main = mainWidget $ do
41 Region (w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)
41 Region (w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)
42 region2 = ffor size $ \(w,h) ->
42 region2 = ffor size $ \(w,h) ->
43 Region (2 * w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)
43 Region (2 * w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)
44− todo' <- pane region1 (pure True) $ button "Todo List"
44+ todo' <- pane region1 (pure True) $ textButtonStatic def "Todo List"
45− editor <- pane region2 (pure True) $ button "Text Editor"
45+ editor <- pane region2 (pure True) $ textButtonStatic def "Text Editor"
46 return $ leftmost
46 return $ leftmost
47 [ Left Example_TextEditor <$ editor
47 [ Left Example_TextEditor <$ editor
48 , Left Example_Todo <$ todo'
48 , Left Example_Todo <$ todo'
@@ -63,7 +63,7 @@ taskList
63 :: (Reflex t, MonadHold t m, MonadFix m, Adjustable t m, NotReady t m, PostBuild t m)
63 :: (Reflex t, MonadHold t m, MonadFix m, Adjustable t m, NotReady t m, PostBuild t m)
64 => VtyWidget t m ()
64 => VtyWidget t m ()
65taskList = do
65taskList = do
66− let btn = button $ pure "Add another task"
66+ let btn = textButtonStatic def "Add another task"
67 inp <- input
67 inp <- input
68 rec let todos' = todos [Todo "First" True, Todo "Second" False, Todo "Third" False] $ leftmost
68 rec let todos' = todos [Todo "First" True, Todo "Second" False, Todo "Third" False] $ leftmost
69 [ () <$ e
69 [ () <$ e
@@ -122,11 +122,6 @@ checkbox v0 = do
122 text $ current $ ffor v $ \v' -> if v' then "[x]" else "[ ]"
122 text $ current $ ffor v $ \v' -> if v' then "[x]" else "[ ]"
123 return v
123 return v
124
124
125−button :: (Reflex t, Monad m) => Behavior t Text -> VtyWidget t m (Event t ())
126−button t = do
127− boxStatic roundedBoxStyle $ text t
128− fmap (() <$) mouseUp
129−
130data TodoOutput t = TodoOutput
125data TodoOutput t = TodoOutput
131 { _todoOutput_todo :: Dynamic t Todo
126 { _todoOutput_todo :: Dynamic t Todo
132 , _todoOutput_delete :: Event t ()
127 , _todoOutput_delete :: Event t ()
src/Reflex/Vty/Widget.hs+27−7
@@ -44,8 +44,11 @@ module Reflex.Vty.Widget
44 , splitVDrag
44 , splitVDrag
45 , box
45 , box
46 , boxStatic
46 , boxStatic
47+ , RichTextConfig(..)
48+ , richText
47 , text
49 , text
48 , display
50 , display
51+ , BoxStyle(..)
49 , hyphenBoxStyle
52 , hyphenBoxStyle
50 , singleBoxStyle
53 , singleBoxStyle
51 , roundedBoxStyle
54 , roundedBoxStyle
@@ -535,20 +538,39 @@ boxStatic
535 -> VtyWidget t m a
538 -> VtyWidget t m a
536boxStatic = box . pure
539boxStatic = box . pure
537
540
538−-- | Renders text, wrapped to the container width
541+-- | Configuration options for displaying "rich" text
539−text
542+data RichTextConfig t = RichTextConfig
543+ { _richTextConfig_attributes :: Behavior t V.Attr
544+ }
545+
546+instance Reflex t => Default (RichTextConfig t) where
547+ def = RichTextConfig $ pure V.defAttr
548+
549+-- | A widget that displays text with custom time-varying attributes
550+richText
540 :: (Reflex t, Monad m)
551 :: (Reflex t, Monad m)
552+ => RichTextConfig t
541− => Behavior t Text
553+ -> Behavior t Text
542 -> VtyWidget t m ()
554 -> VtyWidget t m ()
543−text msg = do
555+richText cfg t = do
544 dw <- displayWidth
556 dw <- displayWidth
545− let img = (\w s -> [wrapText w V.defAttr s]) <$> current dw <*> msg
557+ let img = (\w a s -> [wrapText w a s])
558+ <$> current dw
559+ <*> _richTextConfig_attributes cfg
560+ <*> t
546 tellImages img
561 tellImages img
547 where
562 where
548 wrapText maxWidth attrs = V.vertCat
563 wrapText maxWidth attrs = V.vertCat
549 . concatMap (fmap (V.string attrs . T.unpack) . TZ.wrapWithOffset maxWidth 0)
564 . concatMap (fmap (V.string attrs . T.unpack) . TZ.wrapWithOffset maxWidth 0)
550 . T.split (=='\n')
565 . T.split (=='\n')
551
566
567+-- | Renders text, wrapped to the container width
568+text
569+ :: (Reflex t, Monad m)
570+ => Behavior t Text
571+ -> VtyWidget t m ()
572+text = richText def
573+
552-- | Renders any behavior whose value can be converted to
574-- | Renders any behavior whose value can be converted to
553-- 'String' as text
575-- 'String' as text
554display
576display
@@ -556,5 +578,3 @@ display
556 => Behavior t a
578 => Behavior t a
557 -> VtyWidget t m ()
579 -> VtyWidget t m ()
558display a = text $ T.pack . show <$> a
580display a = text $ T.pack . show <$> a
559−
560−
src/Reflex/Vty/Widget/Input.hs+56−2
@@ -3,7 +3,61 @@ Module: Reflex.Vty.Widget.Input
3Description: User input widgets for reflex-vty
3Description: User input widgets for reflex-vty
4-}
4-}
5module Reflex.Vty.Widget.Input
5module Reflex.Vty.Widget.Input
6+ ( module Export
6− ( module Reflex.Vty.Widget.Input.Text
7+ , module Reflex.Vty.Widget.Input
7 ) where
8 ) where
8
9
10+
9−import Reflex.Vty.Widget.Input.Text
11+import Reflex.Vty.Widget.Input.Text as Export
12+
13+import Data.Default
14+import Data.Text (Text)
15+import qualified Graphics.Vty as V
16+import Reflex
17+import Reflex.Vty.Widget
18+
19+-- | Configuration options for the 'button' widget
20+data ButtonConfig t = ButtonConfig
21+ { _buttonConfig_boxStyle :: Behavior t BoxStyle
22+ }
23+
24+instance Reflex t => Default (ButtonConfig t) where
25+ def = ButtonConfig (pure def)
26+
27+-- | A button widget that contains a sub-widget
28+button
29+ :: (Reflex t, Monad m)
30+ => ButtonConfig t
31+ -> VtyWidget t m ()
32+ -> VtyWidget t m (Event t MouseUp)
33+button cfg child = do
34+ box (_buttonConfig_boxStyle cfg) child
35+ mouseUp
36+
37+-- | A button widget that displays text that can change
38+textButton
39+ :: (Reflex t, Monad m)
40+ => ButtonConfig t
41+ -> Behavior t Text
42+ -> VtyWidget t m (Event t MouseUp)
43+textButton cfg = button cfg . text -- TODO Centering etc.
44+
45+-- | A button widget that displays a static bit of text
46+textButtonStatic
47+ :: (Reflex t, Monad m)
48+ => ButtonConfig t
49+ -> Text
50+ -> VtyWidget t m (Event t MouseUp)
51+textButtonStatic cfg = textButton cfg . pure
52+
53+-- | A clickable link widget
54+link
55+ :: (Reflex t, Monad m)
56+ => Behavior t Text
57+ -> VtyWidget t m (Event t MouseUp)
58+link t = do
59+ let cfg = RichTextConfig
60+ { _richTextConfig_attributes = pure $ V.withStyle V.defAttr V.underline
61+ }
62+ richText cfg t
63+ mouseUp