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

git.iko.soy/reflex-vty

on develop help sign in

Replace string with text

4e65e21Ali Abrar8 years ago

reflex-vty.cabal+1

compare with develop

unifiedsplit

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

39 base,

40 reflex,

41 reflex-vty,

42+ text,

42 time,

43 time,

43 transformers,

44 transformers,

44 vty

45 vty

src-bin/example.hs+6−5

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

10import Control.Monad.Fix

11import Control.Monad.IO.Class

12import Control.Monad.Trans.Reader

13+import qualified Data.Text as T

13import Data.Time

14import Data.Time

14import qualified Graphics.Vty as V

15import qualified Graphics.Vty as V

15import Reflex

16import Reflex

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

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

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

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

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

37 pane region2 (constDyn True) . box singleBoxStyle $

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

39 return ()

40 return ()

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

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

42debugFocus = do

43debugFocus = do

43 f <- focus

44 f <- focus

44− string $ show <$> current f

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

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

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

47debugInput = do

48debugInput = do

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

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

49− string lastEvent

50+ text $ T.pack <$> lastEvent

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

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

52dragTest = do

53dragTest = do

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

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

54− string lastEvent

55+ text $ T.pack <$> lastEvent

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

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

57testStringBox = box singleBoxStyle .

58testStringBox = 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

30 , modifyImages

31 , tellImages

32 , tellShutdown

33− , wrapString

33+ , wrapText

34 , splitV

35 , splitVDrag

36 , fractionSz

37 , box

38− , string

38+ , text

39 , hyphenBoxStyle

40 , singleBoxStyle

41 , roundedBoxStyle

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

417 ]

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

419

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

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

421−string msg = do

421+text msg = do

422 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

424 tellImages img

425

426regionBlankImage :: Region -> Image

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

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

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

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

429

430withinImage :: Region -> Image -> Image

431withinImage (Region left top width height)

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

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

434

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

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

436−wrapString maxWidth attrs = V.vertCat

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

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

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

438− . lines

439

444

440wrapInputState

445wrapInputState

441 :: Int -- ^ Maximum line length

446 :: Int -- ^ Maximum line length

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

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

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

463 (midAfter', midAfterBottom) =

468 (midAfter', midAfterBottom) =

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

469 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

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

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

467 x:xs -> (x, xs)

472 x:xs -> (x, xs)

468 cursor = V.char cursorAttrs cursorChar

473 cursor = V.char cursorAttrs cursorChar

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

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

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

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

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

493 vstring = V.string attrs . T.unpack

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

498 wrap :: [Text] -> [Text]

499 wrap :: [Text] -> [Text]

499− wrap = concatMap (wrapWithOffset 0)

500+ wrap = concatMap (wrapWithOffset maxWidth 0)

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

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

501 headTail = \case

502 headTail = \case

502 [] -> Nothing

503 [] -> Nothing