4e65e21 · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

Replace string with text

commit4e65e2195eb642831e7b0c1362e586b1e59acf97 authorAli Abrar <aliabrar@gmail.com> dateSat 3 Nov 2018, 00:14 (8 years ago) parente3c56f7

3 files changed+25−22

compare with develop

unifiedsplit

reflex-vty.cabal+1 src-bin/example.hs+6−5 src/Reflex/Vty/Widget.hs+18−17

reflex-vty.cabal+1

@@ -39,6 +39,7 @@ executable example

3939 base,

4040 reflex,

4141 reflex-vty,

42+ text,

4243 time,

4344 transformers,

4445 vty

src-bin/example.hs+6−5

@@ -10,6 +10,7 @@ import Control.Monad

1010import Control.Monad.Fix

1111import Control.Monad.IO.Class

1212import Control.Monad.Trans.Reader

13+import qualified Data.Text as T

1314import Data.Time

1415import qualified Graphics.Vty as V

1516import Reflex

@@ -35,24 +36,24 @@ testBoxes = do

3536 region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) size

3637 pane region1 (constDyn False) . box singleBoxStyle $ debugInput

3738 pane region2 (constDyn True) . box singleBoxStyle $

38− splitVDrag (hRule doubleBoxStyle) (box roundedBoxStyle debugInput) (box roundedBoxStyle dragTest)

39+ splitVDrag (hRule doubleBoxStyle) (box roundedBoxStyle $ multilineTextInput def) (box roundedBoxStyle dragTest)

3940 return ()

4041

4142debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()

4243debugFocus = do

4344 f <- focus

44− string $ show <$> current f

45+ text $ T.pack . show <$> current f

4546

4647debugInput :: (Reflex t, MonadHold t m) => VtyWidget t m ()

4748debugInput = do

4849 lastEvent <- hold "No event yet" . fmap show =<< input

49− string lastEvent

50+ text $ T.pack <$> lastEvent

5051

5152dragTest :: (Reflex t, MonadHold t m, MonadFix m) => VtyWidget t m ()

5253dragTest = do

5354 lastEvent <- hold "No event yet" . fmap show =<< drag V.BLeft

54− string lastEvent

55+ text $ T.pack <$> lastEvent

5556

5657testStringBox :: (Reflex t, Monad m) => VtyWidget t m ()

5758testStringBox = box singleBoxStyle .

58− string . pure . take 500 $ cycle ('\n' : ['a'..'z'])

59+ text . pure . T.pack . take 500 $ cycle ('\n' : ['a'..'z'])

src/Reflex/Vty/Widget.hs+18−17

@@ -30,12 +30,12 @@ module Reflex.Vty.Widget

3030 , modifyImages

3131 , tellImages

3232 , tellShutdown

33− , wrapString

33+ , wrapText

3434 , splitV

3535 , splitVDrag

3636 , fractionSz

3737 , box

38− , string

38+ , text

3939 , hyphenBoxStyle

4040 , singleBoxStyle

4141 , roundedBoxStyle

@@ -417,25 +417,30 @@ box style child = do

417417 ]

418418 in sides ++ if width > 1 && height > 1 then corners else []

419419

420−string :: (Reflex t, Monad m) => Behavior t String -> VtyWidget t m ()

421−string msg = do

420+text :: (Reflex t, Monad m) => Behavior t Text -> VtyWidget t m ()

421+text msg = do

422422 dw <- displayWidth

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

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

424424 tellImages img

425425

426426regionBlankImage :: Region -> Image

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

428− withinImage r $ wrapString width V.defAttr $ replicate (width * height) ' '

427+regionBlankImage r@(Region left top width height) =

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

429429

430430withinImage :: Region -> Image -> Image

431431withinImage (Region left top width height)

432432 | width < 0 || height < 0 = withinImage (Region left top 0 0)

433433 | otherwise = V.translate left top . V.crop width height

434434

435−wrapString :: Int -> Attr -> String -> Image

436−wrapString maxWidth attrs = V.vertCat

437− . concatMap (fmap (V.string attrs) . fmap (take maxWidth) . takeWhile (not . null) . iterate (drop maxWidth))

438− . lines

435+wrapText :: Int -> Attr -> Text -> Image

436+wrapText maxWidth attrs = V.vertCat

437+ . concatMap (fmap (V.string attrs . T.unpack) . wrapWithOffset maxWidth 0)

438+ . T.split (=='\n')

439+

440+wrapWithOffset :: Int -> Int -> Text -> [Text]

441+wrapWithOffset maxWidth n xs =

442+ let (firstLine, rest) = T.splitAt (maxWidth - n) xs

443+ in firstLine : (fmap (T.take maxWidth) . takeWhile (not . T.null) . iterate (T.drop maxWidth) $ rest)

439444

440445wrapInputState

441446 :: Int -- ^ Maximum line length

@@ -462,7 +467,7 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =

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

463468 (midAfter', midAfterBottom) =

464469 let offset = if T.length midBefore' == maxWidth then 1 else T.length midBefore' + 1

465− in case wrapWithOffset offset midAfter of

470+ in case wrapWithOffset maxWidth offset midAfter of

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

467472 x:xs -> (x, xs)

468473 cursor = V.char cursorAttrs cursorChar

@@ -491,12 +496,8 @@ wrapInputState maxWidth attrs cursorAttrs (InputState before after) =

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

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

493498 vstring = V.string attrs . T.unpack

494− wrapWithOffset :: Int -> Text -> [Text]

495− wrapWithOffset n xs =

496− let (firstLine, rest) = T.splitAt (maxWidth - n) xs

497− in firstLine : (fmap (T.take maxWidth) . takeWhile (not . T.null) . iterate (T.drop maxWidth) $ rest)

498499 wrap :: [Text] -> [Text]

499− wrap = concatMap (wrapWithOffset 0)

500+ wrap = concatMap (wrapWithOffset maxWidth 0)

500501 headTail :: [a] -> Maybe (a, [a])

501502 headTail = \case

502503 [] -> Nothing