ec68759 · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

on develop help sign in

Scrolling text input

ec68759Ali Abrar8 years ago

src/Reflex/Vty/Widget.hs+38−8

compare with develop

unifiedsplit

@@ -36,6 +36,7 @@ module Reflex.Vty.Widget

36 , fractionSz

37 , box

38 , text

39+ , display

39 , hyphenBoxStyle

40 , hyphenBoxStyle

40 , singleBoxStyle

41 , singleBoxStyle

41 , roundedBoxStyle

42 , roundedBoxStyle

@@ -423,6 +424,9 @@ text msg = do

423 let img = (\w s -> [wrapText w V.defAttr s]) <$> current dw <*> msg

424 let img = (\w s -> [wrapText w V.defAttr s]) <$> current dw <*> msg

424 tellImages img

425 tellImages img

425

426

427+display :: (Reflex t, Monad m, Show a) => Behavior t a -> VtyWidget t m ()

428+display a = text $ T.pack . show <$> a

429+

426regionBlankImage :: Region -> Image

430regionBlankImage :: Region -> Image

427regionBlankImage r@(Region _ _ width height) =

431regionBlankImage r@(Region _ _ width height) =

428 withinImage r $ V.charFill V.defAttr ' ' width height

432 withinImage r $ V.charFill V.defAttr ' ' width height

@@ -447,7 +451,7 @@ wrapInputState

447 -> Attr -- ^ Normal string attributes

451 -> Attr -- ^ Normal string attributes

448 -> Attr -- ^ Cursor character attributes

452 -> Attr -- ^ Cursor character attributes

449 -> InputState -- ^ The input to render

453 -> InputState -- ^ The input to render

450− -> Image

454+ -> ([Image], Int)

451wrapInputState maxWidth attrs cursorAttrs (InputState before after) =

455wrapInputState maxWidth attrs cursorAttrs (InputState before after) =

452 let -- Break up the InputState into:

456 let -- Break up the InputState into:

453 -- * A top section of lines before the line containing the cursor

457 -- * A top section of lines before the line containing the cursor

@@ -465,16 +469,17 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =

465 Nothing -> (top', midB, ' ', "", bottom')

469 Nothing -> (top', midB, ' ', "", bottom')

466 Just (c, rest) -> (top', midB, c, rest, bottom')

470 Just (c, rest) -> (top', midB, c, rest, bottom')

467 (midBeforeTop, midBefore') = fromMaybe ([], "") $ initLast $ wrap [midBefore]

471 (midBeforeTop, midBefore') = fromMaybe ([], "") $ initLast $ wrap [midBefore]

472+ cursorAfterEOL = T.length midBefore' == maxWidth

468 (midAfter', midAfterBottom) =

473 (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

470 in case wrapWithOffset maxWidth offset midAfter of

475 in case wrapWithOffset maxWidth offset midAfter of

471 [] -> ("", [])

476 [] -> ("", [])

472 x:xs -> (x, xs)

477 x:xs -> (x, xs)

473 cursor = V.char cursorAttrs cursorChar

478 cursor = V.char cursorAttrs cursorChar

474− in V.vertCat $ mconcat

479+ images = mconcat

475 [ vstring <$> wrap top

480 [ vstring <$> wrap top

476 , vstring <$> midBeforeTop

481 , vstring <$> midBeforeTop

477− , if T.length midBefore' == maxWidth

482+ , if cursorAfterEOL

478 then

483 then

479 [ vstring midBefore'

484 [ vstring midBefore'

480 , V.horizCat

485 , V.horizCat

@@ -492,6 +497,8 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =

492 , vstring <$> midAfterBottom

497 , vstring <$> midAfterBottom

493 , vstring <$> bottom

498 , vstring <$> bottom

494 ]

499 ]

500+ cursorY = length top + length midBeforeTop + if cursorAfterEOL then 1 else 0

501+ in (images, cursorY)

495 where

502 where

496 before' = T.split (=='\n') before

503 before' = T.split (=='\n') before

497 after' = T.split (=='\n') after

504 after' = T.split (=='\n') after

@@ -536,6 +543,21 @@ updateInputState ev i@(InputState before after) = case ev of

536 V.EvKey V.KLeft [] -> case T.unsnoc before of

543 V.EvKey V.KLeft [] -> case T.unsnoc before of

537 Nothing -> i

544 Nothing -> i

538 Just (bs, b) -> InputState bs (T.cons b after)

545 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)

539 _ -> i

561 _ -> i

540

562

541data TextInputConfig t = TextInputConfig

563data TextInputConfig t = TextInputConfig

@@ -554,10 +576,18 @@ textInput cfg = do

554 , _textInputConfig_modifyInputState cfg

576 , _textInputConfig_modifyInputState cfg

555 ]

577 ]

556 dw <- displayWidth

578 dw <- displayWidth

579+ dh <- displayHeight

557− let img = (\w s -> [wrapInputState w V.defAttr (V.withStyle V.defAttr V.reverseVideo) s]) -- TODO cursor ought to blink

580+ let img = (\w s -> wrapInputState w V.defAttr (V.withStyle V.defAttr V.reverseVideo) s) -- TODO cursor ought to blink

558− <$> current dw

581+ <$> dw

559− <*> current v

582+ <*> v

560− tellImages img

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

561 return $ inputValue <$> v

591 return $ inputValue <$> v

562

592

563multilineTextInput :: (Reflex t, MonadHold t m, MonadFix m) => TextInputConfig t -> VtyWidget t m (Dynamic t Text)

593multilineTextInput :: (Reflex t, MonadHold t m, MonadFix m) => TextInputConfig t -> VtyWidget t m (Dynamic t Text)