@@ -2,6 +2,8 @@
22Module: Reflex.Vty.Widget.Input
33Description: User input widgets for reflex-vty
44-}
5+{-# LANGUAGE LambdaCase #-}
6+{-# LANGUAGE OverloadedStrings #-}
57module Reflex.Vty.Widget.Input
68 ( module Export
79 , module Reflex.Vty.Widget.Input
@@ -10,8 +12,11 @@ module Reflex.Vty.Widget.Input
1012
1113import Reflex.Vty.Widget.Input.Text as Export
1214
13−import Data.Default
15+import Control.Monad (join)
16+import Control.Monad.Fix (MonadFix)
17+import Data.Default (Default(..))
1418import Data.Text (Text)
19+import Data.Text.Zipper (Span)
1520import qualified Graphics.Vty as V
1621import Reflex
1722import Reflex.Vty.Widget
@@ -68,3 +73,59 @@ linkStatic
6873 => Text
6974 -> VtyWidget t m (Event t MouseUp)
7075linkStatic = 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