ed6ffff · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

Add some button widgets and a rich-text widget

commited6ffff5162239c1099907e262b29d6bd91c4126 authorAli Abrar <aliabrar@gmail.com> dateMon 5 Nov 2018, 00:46 (8 years ago) parent0ee701e

3 files changed+86−17

compare with develop

unifiedsplit

src-bin/example.hs+3−8 src/Reflex/Vty/Widget.hs+27−7 src/Reflex/Vty/Widget/Input.hs+56−2

src-bin/example.hs+3−8

@@ -41,8 +41,8 @@ main = mainWidget $ do

4141 Region (w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)

4242 region2 = ffor size $ \(w,h) ->

4343 Region (2 * w `div` 6) (h `div` 6) (w `div` 6) (h `div` 6)

44− todo' <- pane region1 (pure True) $ button "Todo List"

45− editor <- pane region2 (pure True) $ button "Text Editor"

44+ todo' <- pane region1 (pure True) $ textButtonStatic def "Todo List"

45+ editor <- pane region2 (pure True) $ textButtonStatic def "Text Editor"

4646 return $ leftmost

4747 [ Left Example_TextEditor <$ editor

4848 , Left Example_Todo <$ todo'

@@ -63,7 +63,7 @@ taskList

6363 :: (Reflex t, MonadHold t m, MonadFix m, Adjustable t m, NotReady t m, PostBuild t m)

6464 => VtyWidget t m ()

6565taskList = do

66− let btn = button $ pure "Add another task"

66+ let btn = textButtonStatic def "Add another task"

6767 inp <- input

6868 rec let todos' = todos [Todo "First" True, Todo "Second" False, Todo "Third" False] $ leftmost

6969 [ () <$ e

@@ -122,11 +122,6 @@ checkbox v0 = do

122122 text $ current $ ffor v $ \v' -> if v' then "[x]" else "[ ]"

123123 return v

124124

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−

130125data TodoOutput t = TodoOutput

131126 { _todoOutput_todo :: Dynamic t Todo

132127 , _todoOutput_delete :: Event t ()

src/Reflex/Vty/Widget.hs+27−7

@@ -44,8 +44,11 @@ module Reflex.Vty.Widget

4444 , splitVDrag

4545 , box

4646 , boxStatic

47+ , RichTextConfig(..)

48+ , richText

4749 , text

4850 , display

51+ , BoxStyle(..)

4952 , hyphenBoxStyle

5053 , singleBoxStyle

5154 , roundedBoxStyle

@@ -535,20 +538,39 @@ boxStatic

535538 -> VtyWidget t m a

536539boxStatic = box . pure

537540

538−-- | Renders text, wrapped to the container width

539−text

541+-- | Configuration options for displaying "rich" 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

540551 :: (Reflex t, Monad m)

541− => Behavior t Text

552+ => RichTextConfig t

553+ -> Behavior t Text

542554 -> VtyWidget t m ()

543−text msg = do

555+richText cfg t = do

544556 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

546561 tellImages img

547562 where

548563 wrapText maxWidth attrs = V.vertCat

549564 . concatMap (fmap (V.string attrs . T.unpack) . TZ.wrapWithOffset maxWidth 0)

550565 . T.split (=='\n')

551566

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+

552574-- | Renders any behavior whose value can be converted to

553575-- 'String' as text

554576display

@@ -556,5 +578,3 @@ display

556578 => Behavior t a

557579 -> VtyWidget t m ()

558580display 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

33Description: User input widgets for reflex-vty

44-}

55module Reflex.Vty.Widget.Input

6− ( module Reflex.Vty.Widget.Input.Text

6+ ( module Export

7+ , module Reflex.Vty.Widget.Input

78 ) where

9−import Reflex.Vty.Widget.Input.Text

10+

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