git.iko.soy/reflex-vty
on develop help sign in
Click with mouse to move text input cursor
c5331bfAli Abrar
src/Data/Text/Zipper.hs+17−2
compare with develop
unifiedsplit
@@ -228,8 +228,6 @@ displayLines width tag cursorTag (TextZipper lb b a la) =
228 ]
228 ]
229 }
229 }
230 where
230 where
231− spansLength :: [Span tag] -> Int
232− spansLength = sum . map (\(Span _ t) -> T.length t)
233 initLast :: [a] -> Maybe ([a], a)
231 initLast :: [a] -> Maybe ([a], a)
234 initLast = \case
232 initLast = \case
235 [] -> Nothing
233 [] -> Nothing
@@ -281,3 +279,20 @@ offsetMap ts = evalState (offsetMap' ts) (0, 0)
281 (dl, o) <- get
279 (dl, o) <- get
282 put (dl, o + 1)
280 put (dl, o + 1)
283 return $ Map.insert dl (o + 1) $ Map.unions maps
281 return $ Map.insert dl (o + 1) $ Map.unions maps
282+
283+-- | Move the cursor of the given 'TextZipper' to the logical position indicated by
284+-- the given display line coordinates, using the provided 'DisplayLines' information.
285+goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
286+goToDisplayLinePosition x y dl tz =
287+ let offset = Map.lookup y $ _displayLines_offsetMap dl
288+ in case offset of
289+ Nothing -> tz
290+ Just o ->
291+ let displayLineLength = case drop y $ _displayLines_spans dl of
292+ [] -> x
293+ (s:_) -> spansLength s
294+ in rightN (o + (min displayLineLength x)) $ top tz
295+
296+-- | Get the length of the text in a set of 'Span's
297+spansLength :: [Span tag] -> Int
298+spansLength = sum . map (\(Span _ t) -> T.length t)
src/Reflex/Vty/Widget/Input/Text.hs+21−16
@@ -37,22 +37,27 @@ textInput
37 -> VtyWidget t m (Dynamic t Text)
37 -> VtyWidget t m (Dynamic t Text)
38textInput cfg = do
38textInput cfg = do
39 i <- input
39 i <- input
40− v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
40+ rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
41− [ updateTextZipper <$> i
41+ [ updateTextZipper <$> i
42− , _textInputConfig_modify cfg
42+ , _textInputConfig_modify cfg
43+ , let displayInfo = (,) <$> rows <*> scrollTop
44+ in ffor (attach (current displayInfo) click) $ \((dl, st), MouseDown _ (mx, my) _) ->
45+ goToDisplayLinePosition mx (st + my) dl
43− ]
46+ ]
44− dw <- displayWidth
47+ dw <- displayWidth
45− dh <- displayHeight
48+ dh <- displayHeight
49+ click <- mouseDown V.BLeft
46− let rows = (\w s -> displayLines w V.defAttr cursorAttributes s) <$> dw <*> v
50+ let rows = (\w s -> displayLines w V.defAttr cursorAttributes s) <$> dw <*> v
47− img = images . _displayLines_spans <$> rows
51+ img = images . _displayLines_spans <$> rows
48− y <- holdUniqDyn $ _displayLines_cursorY <$> rows
52+ y <- holdUniqDyn $ _displayLines_cursorY <$> rows
49− let newScrollTop st (h, cursorY)
53+ let newScrollTop :: Int -> (Int, Int) -> Int
54+ newScrollTop st (h, cursorY)
50− | cursorY < st = cursorY
55+ | cursorY < st = cursorY
51− | cursorY >= st + h = cursorY - h + 1
56+ | cursorY >= st + h = cursorY - h + 1
52− | otherwise = st
57+ | otherwise = st
53− rec let hy = attachWith newScrollTop (current scrollTop) $ updated $ zipDyn dh y
58+ rec let hy = attachWith newScrollTop (current scrollTop) $ updated $ zipDyn dh y
54− scrollTop <- holdDyn 0 hy
59+ scrollTop <- holdDyn 0 hy
55− tellImages $ (\imgs st -> (:[]) . V.vertCat $ drop st imgs) <$> current img <*> current scrollTop
60+ tellImages $ (\imgs st -> (:[]) . V.vertCat $ drop st imgs) <$> current img <*> current scrollTop
56 return $ value <$> v
61 return $ value <$> v
57
62
58-- | A widget that allows multiline text input
63-- | A widget that allows multiline text input