git.iko.soy/reflex-vty
on develop help sign in
Add checkbox
e4d9d8dAli Abrar
src-bin/example.hs+1−13
compare with develop
unifiedsplit
@@ -110,18 +110,6 @@ data Todo = Todo
110 }
110 }
111 deriving (Show, Read, Eq, Ord)
111 deriving (Show, Read, Eq, Ord)
112
112
113−checkbox
114− :: (MonadHold t m, MonadFix m, Reflex t)
115− => Bool
116− -> VtyWidget t m (Dynamic t Bool)
117−checkbox v0 = do
118− i <- input
119− v <- toggle v0 $ fforMaybe i $ \case
120− V.EvMouseUp _ _ _ -> Just ()
121− _ -> Nothing
122− text $ current $ ffor v $ \v' -> if v' then "[x]" else "[ ]"
123− return v
124−
125data TodoOutput t = TodoOutput
113data TodoOutput t = TodoOutput
126 { _todoOutput_todo :: Dynamic t Todo
114 { _todoOutput_todo :: Dynamic t Todo
127 , _todoOutput_delete :: Event t ()
115 , _todoOutput_delete :: Event t ()
@@ -141,7 +129,7 @@ todo t0 = do
141 let checkboxWidth = 3
129 let checkboxWidth = 3
142 checkboxRegion = pure $ Region 0 0 checkboxWidth 1
130 checkboxRegion = pure $ Region 0 0 checkboxWidth 1
143 labelRegion = ffor w $ \w' -> Region (checkboxWidth + 1) 0 (w' - 1 - checkboxWidth) 1
131 labelRegion = ffor w $ \w' -> Region (checkboxWidth + 1) 0 (w' - 1 - checkboxWidth) 1
144− value <- pane checkboxRegion (pure True) $ checkbox $ _todo_done t0
132+ value <- pane checkboxRegion (pure True) $ checkbox def $ _todo_done t0
145 (label, d) <- pane labelRegion (pure True) $ do
133 (label, d) <- pane labelRegion (pure True) $ do
146 i <- input
134 i <- input
147 v <- textInput $ def { _textInputConfig_initialValue = TZ.fromText $ _todo_label t0 }
135 v <- textInput $ def { _textInputConfig_initialValue = TZ.fromText $ _todo_label t0 }
src/Reflex/Vty/Widget/Input.hs+62−1
@@ -2,6 +2,8 @@
2Module: Reflex.Vty.Widget.Input
2Module: Reflex.Vty.Widget.Input
3Description: User input widgets for reflex-vty
3Description: User input widgets for reflex-vty
4-}
4-}
5+{-# LANGUAGE LambdaCase #-}
6+{-# LANGUAGE OverloadedStrings #-}
5module Reflex.Vty.Widget.Input
7module Reflex.Vty.Widget.Input
6 ( module Export
8 ( module Export
7 , module Reflex.Vty.Widget.Input
9 , module Reflex.Vty.Widget.Input
@@ -10,8 +12,11 @@ module Reflex.Vty.Widget.Input
10
12
11import Reflex.Vty.Widget.Input.Text as Export
13import Reflex.Vty.Widget.Input.Text as Export
12
14
15+import Control.Monad (join)
16+import Control.Monad.Fix (MonadFix)
13−import Data.Default
17+import Data.Default (Default(..))
14import Data.Text (Text)
18import Data.Text (Text)
19+import Data.Text.Zipper (Span)
15import qualified Graphics.Vty as V
20import qualified Graphics.Vty as V
16import Reflex
21import Reflex
17import Reflex.Vty.Widget
22import Reflex.Vty.Widget
@@ -68,3 +73,59 @@ linkStatic
68 => Text
73 => Text
69 -> VtyWidget t m (Event t MouseUp)
74 -> VtyWidget t m (Event t MouseUp)
70linkStatic = link . pure
75linkStatic = link . pure
76+
77+-- | Characters used to render checked and unchecked textboxes
78+data CheckboxStyle = CheckboxStyle
79+ { _checkboxStyle_unchecked :: Text
80+ , _checkboxStyle_checked :: Text
81+ }
82+
83+instance Default CheckboxStyle where
84+ def = checkboxStyleTick
85+
86+-- | This checkbox style uses an "x" to indicate the checked state
87+checkboxStyleX :: CheckboxStyle
88+checkboxStyleX = CheckboxStyle
89+ { _checkboxStyle_unchecked = "[ ]"
90+ , _checkboxStyle_checked = "[x]"
91+ }
92+
93+-- | This checkbox style uses a unicode tick mark to indicate the checked state
94+checkboxStyleTick :: CheckboxStyle
95+checkboxStyleTick = CheckboxStyle
96+ { _checkboxStyle_unchecked = "[ ]"
97+ , _checkboxStyle_checked = "[✓]"
98+ }
99+
100+-- | Configuration options for a checkbox
101+data CheckboxConfig t = CheckboxConfig
102+ { _checkboxConfig_checkboxStyle :: Behavior t CheckboxStyle
103+ , _checkboxConfig_attributes :: Behavior t V.Attr
104+ }
105+
106+instance (Reflex t) => Default (CheckboxConfig t) where
107+ def = CheckboxConfig
108+ { _checkboxConfig_checkboxStyle = pure def
109+ , _checkboxConfig_attributes = pure V.defAttr
110+ }
111+
112+-- | A checkbox widget
113+checkbox
114+ :: (MonadHold t m, MonadFix m, Reflex t)
115+ => CheckboxConfig t
116+ -> Bool
117+ -> VtyWidget t m (Dynamic t Bool)
118+checkbox cfg v0 = do
119+ md <- mouseDown V.BLeft
120+ mu <- mouseUp
121+ v <- toggle v0 $ () <$ mu
122+ depressed <- hold mempty $ leftmost
123+ [ V.withStyle mempty V.bold <$ md
124+ , mempty <$ mu
125+ ]
126+ let attrs = (<>) <$> (_checkboxConfig_attributes cfg) <*> depressed
127+ richText (RichTextConfig attrs) $ join . current $ ffor v $ \checked ->
128+ if checked
129+ then fmap _checkboxStyle_checked $ _checkboxConfig_checkboxStyle cfg
130+ else fmap _checkboxStyle_unchecked $ _checkboxConfig_checkboxStyle cfg
131+ return v