@@ -37,22 +37,27 @@ textInput
3737 -> VtyWidget t m (Dynamic t Text)
3838textInput cfg = do
3939 i <- input
40− v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
41− [ updateTextZipper <$> i
42− , _textInputConfig_modify cfg
43− ]
44− dw <- displayWidth
45− dh <- displayHeight
46− let rows = (\w s -> displayLines w V.defAttr cursorAttributes s) <$> dw <*> v
47− img = images . _displayLines_spans <$> rows
48− y <- holdUniqDyn $ _displayLines_cursorY <$> rows
49− let newScrollTop st (h, cursorY)
50− | cursorY < st = cursorY
51− | cursorY >= st + h = cursorY - h + 1
52− | otherwise = st
53− rec let hy = attachWith newScrollTop (current scrollTop) $ updated $ zipDyn dh y
54− scrollTop <- holdDyn 0 hy
55− tellImages $ (\imgs st -> (:[]) . V.vertCat $ drop st imgs) <$> current img <*> current scrollTop
40+ rec v <- foldDyn ($) (_textInputConfig_initialValue cfg) $ mergeWith (.)
41+ [ updateTextZipper <$> i
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
46+ ]
47+ dw <- displayWidth
48+ dh <- displayHeight
49+ click <- mouseDown V.BLeft
50+ let rows = (\w s -> displayLines w V.defAttr cursorAttributes s) <$> dw <*> v
51+ img = images . _displayLines_spans <$> rows
52+ y <- holdUniqDyn $ _displayLines_cursorY <$> rows
53+ let newScrollTop :: Int -> (Int, Int) -> Int
54+ newScrollTop st (h, cursorY)
55+ | cursorY < st = cursorY
56+ | cursorY >= st + h = cursorY - h + 1
57+ | otherwise = st
58+ rec let hy = attachWith newScrollTop (current scrollTop) $ updated $ zipDyn dh y
59+ scrollTop <- holdDyn 0 hy
60+ tellImages $ (\imgs st -> (:[]) . V.vertCat $ drop st imgs) <$> current img <*> current scrollTop
5661 return $ value <$> v
5762
5863-- | A widget that allows multiline text input