diff --git a/ChangeLog.md b/ChangeLog.md index b922458..2dc5ada 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for reflex-vty +## 0.1.2.0 +* Allow TextZipper contents to be tranformed before being displayed +* Fix bug in `row` orientation + ## 0.1.1.1 * Bump minimum version of reflex diff --git a/src/Data/Text/Zipper.hs b/src/Data/Text/Zipper.hs index 04c321d..134d84d 100644 --- a/src/Data/Text/Zipper.hs +++ b/src/Data/Text/Zipper.hs @@ -39,6 +39,15 @@ data TextZipper = TextZipper instance IsString TextZipper where fromString = fromText . T.pack +-- | Map a replacement function over the characters in a 'TextZipper' +mapZipper :: (Char -> Char) -> TextZipper -> TextZipper +mapZipper f (TextZipper lb b a la) = TextZipper + { _textZipper_linesBefore = fmap (T.map f) lb + , _textZipper_before = T.map f b + , _textZipper_after = T.map f a + , _textZipper_linesAfter = fmap (T.map f) la + } + -- | Move the cursor left one character, if possible left :: TextZipper -> TextZipper left = leftN 1 diff --git a/src/Reflex/Vty/Widget/Input/Text.hs b/src/Reflex/Vty/Widget/Input/Text.hs index 27d6b28..70b52d1 100644 --- a/src/Reflex/Vty/Widget/Input/Text.hs +++ b/src/Reflex/Vty/Widget/Input/Text.hs @@ -30,10 +30,13 @@ data TextInputConfig t = TextInputConfig { _textInputConfig_initialValue :: TextZipper , _textInputConfig_modify :: Event t (TextZipper -> TextZipper) , _textInputConfig_tabWidth :: Int + , _textInputConfig_display :: Char -> Char + -- ^ Transform the characters in a text input before displaying them. This is useful, e.g., for + -- masking characters when entering passwords. } instance Reflex t => Default (TextInputConfig t) where - def = TextInputConfig empty never 4 + def = TextInputConfig empty never 4 id -- | The output produced by text input widgets, including the text -- value and the number of display lines (post-wrapping). Note that some @@ -62,7 +65,10 @@ textInput cfg = do ] click <- mouseDown V.BLeft let cursorAttrs = ffor f $ \x -> if x then cursorAttributes else V.defAttr - let rows = (\w s c -> displayLines w V.defAttr c s) <$> dw <*> v <*> cursorAttrs + let rows = (\w s c -> displayLines w V.defAttr c s) + <$> dw + <*> (mapZipper (_textInputConfig_display cfg) <$> v) + <*> cursorAttrs img = images . _displayLines_spans <$> rows y <- holdUniqDyn $ _displayLines_cursorY <$> rows let newScrollTop :: Int -> (Int, Int) -> Int