@@ -36,6 +36,7 @@ module Reflex.Vty.Widget
3636 , fractionSz
3737 , box
3838 , text
39+ , display
3940 , hyphenBoxStyle
4041 , singleBoxStyle
4142 , roundedBoxStyle
@@ -423,6 +424,9 @@ text msg = do
423424 let img = (\w s -> [wrapText w V.defAttr s]) <$> current dw <*> msg
424425 tellImages img
425426
427+display :: (Reflex t, Monad m, Show a) => Behavior t a -> VtyWidget t m ()
428+display a = text $ T.pack . show <$> a
429+
426430regionBlankImage :: Region -> Image
427431regionBlankImage r@(Region _ _ width height) =
428432 withinImage r $ V.charFill V.defAttr ' ' width height
@@ -447,7 +451,7 @@ wrapInputState
447451 -> Attr -- ^ Normal string attributes
448452 -> Attr -- ^ Cursor character attributes
449453 -> InputState -- ^ The input to render
450− -> Image
454+ -> ([Image], Int)
451455wrapInputState maxWidth attrs cursorAttrs (InputState before after) =
452456 let -- Break up the InputState into:
453457 -- * A top section of lines before the line containing the cursor
@@ -465,16 +469,17 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =
465469 Nothing -> (top', midB, ' ', "", bottom')
466470 Just (c, rest) -> (top', midB, c, rest, bottom')
467471 (midBeforeTop, midBefore') = fromMaybe ([], "") $ initLast $ wrap [midBefore]
472+ cursorAfterEOL = T.length midBefore' == maxWidth
468473 (midAfter', midAfterBottom) =
469− let offset = if T.length midBefore' == maxWidth then 1 else T.length midBefore' + 1
474+ let offset = if cursorAfterEOL then 1 else T.length midBefore' + 1
470475 in case wrapWithOffset maxWidth offset midAfter of
471476 [] -> ("", [])
472477 x:xs -> (x, xs)
473478 cursor = V.char cursorAttrs cursorChar
474− in V.vertCat $ mconcat
479+ images = mconcat
475480 [ vstring <$> wrap top
476481 , vstring <$> midBeforeTop
477− , if T.length midBefore' == maxWidth
482+ , if cursorAfterEOL
478483 then
479484 [ vstring midBefore'
480485 , V.horizCat
@@ -492,6 +497,8 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =
492497 , vstring <$> midAfterBottom
493498 , vstring <$> bottom
494499 ]
500+ cursorY = length top + length midBeforeTop + if cursorAfterEOL then 1 else 0
501+ in (images, cursorY)
495502 where
496503 before' = T.split (=='\n') before
497504 after' = T.split (=='\n') after
@@ -536,6 +543,21 @@ updateInputState ev i@(InputState before after) = case ev of
536543 V.EvKey V.KLeft [] -> case T.unsnoc before of
537544 Nothing -> i
538545 Just (bs, b) -> InputState bs (T.cons b after)
546+ V.EvKey V.KUp [] ->
547+ let (pre, post) = T.breakOnEnd "\n" before
548+ (top, previousLine) = T.breakOnEnd "\n" (T.dropEnd 1 pre)
549+ (previousLineBefore, previousLineAfter) = T.splitAt (T.length post) previousLine
550+ in if T.null pre
551+ then i
552+ else InputState (top <> previousLineBefore) (previousLineAfter <> "\n" <> post <> after)
553+ V.EvKey V.KDown [] ->
554+ let offset = T.length $ T.takeWhileEnd (/='\n') before
555+ (pre, post) = T.breakOn "\n" after
556+ (nextLine, rest) = T.breakOn "\n" (T.drop 1 post)
557+ (nextLineBefore, nextLineAfter) = T.splitAt offset nextLine
558+ in if T.null post
559+ then i
560+ else InputState (before <> pre <> "\n" <> nextLineBefore) (nextLineAfter <> rest)
539561 _ -> i
540562
541563data TextInputConfig t = TextInputConfig
@@ -554,10 +576,18 @@ textInput cfg = do
554576 , _textInputConfig_modifyInputState cfg
555577 ]
556578 dw <- displayWidth
557− let img = (\w s -> [wrapInputState w V.defAttr (V.withStyle V.defAttr V.reverseVideo) s]) -- TODO cursor ought to blink
558− <$> current dw
559− <*> current v
560− tellImages img
579+ dh <- displayHeight
580+ let img = (\w s -> wrapInputState w V.defAttr (V.withStyle V.defAttr V.reverseVideo) s) -- TODO cursor ought to blink
581+ <$> dw
582+ <*> v
583+ y <- holdUniqDyn $ snd <$> img
584+ let newScrollTop st (h, cursorY)
585+ | cursorY < st = cursorY
586+ | cursorY >= st + h = cursorY - h + 1
587+ | otherwise = st
588+ rec let hy = attachWith newScrollTop (current scrollTop) $ updated $ zipDyn dh y
589+ scrollTop <- holdDyn 0 hy
590+ tellImages $ (\(imgs, _) st -> (:[]) . V.vertCat $ drop st imgs) <$> current img <*> current scrollTop
561591 return $ inputValue <$> v
562592
563593multilineTextInput :: (Reflex t, MonadHold t m, MonadFix m) => TextInputConfig t -> VtyWidget t m (Dynamic t Text)