module Reflex.Vty.Widget.Text where
import Control.Monad.Fix
import Data.Default
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Zipper as TZ
import qualified Graphics.Vty as V
import Reflex
import Reflex.Vty.Widget
import Reflex.Vty.Widget.Scroll
fill :: (HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => Behavior t Char -> m ()
fill :: Behavior t Char -> m ()
fill Behavior t Char
bc = do
Dynamic t Int
dw <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
Dynamic t Int
dh <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayHeight
Behavior t Attr
bt <- m (Behavior t Attr)
forall k (t :: k) (m :: * -> *).
HasTheme t m =>
m (Behavior t Attr)
theme
let fillImg :: Behavior t [Image]
fillImg =
(\Attr
attr Int
w Int
h Char
c -> [Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
attr Char
c Int
w Int
h])
(Attr -> Int -> Int -> Char -> [Image])
-> Behavior t Attr -> Behavior t (Int -> Int -> Char -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t Attr
bt
Behavior t (Int -> Int -> Char -> [Image])
-> Behavior t Int -> Behavior t (Int -> Char -> [Image])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dw
Behavior t (Int -> Char -> [Image])
-> Behavior t Int -> Behavior t (Char -> [Image])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dh
Behavior t (Char -> [Image])
-> Behavior t Char -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Char
bc
Behavior t [Image] -> m ()
forall k (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages Behavior t [Image]
fillImg
data RichTextConfig t = RichTextConfig
{ RichTextConfig t -> Behavior t Attr
_richTextConfig_attributes :: Behavior t V.Attr
}
instance Reflex t => Default (RichTextConfig t) where
def :: RichTextConfig t
def = Behavior t Attr -> RichTextConfig t
forall k (t :: k). Behavior t Attr -> RichTextConfig t
RichTextConfig (Behavior t Attr -> RichTextConfig t)
-> Behavior t Attr -> RichTextConfig t
forall a b. (a -> b) -> a -> b
$ Attr -> Behavior t Attr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attr
V.defAttr
richText
:: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)
=> RichTextConfig t
-> Behavior t Text
-> m ()
richText :: RichTextConfig t -> Behavior t Text -> m ()
richText RichTextConfig t
cfg Behavior t Text
t = do
Dynamic t Int
dw <- m (Dynamic t Int)
forall k (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Int)
displayWidth
let img :: Behavior t [Image]
img = (\Int
w Attr
a Text
s -> [Int -> Attr -> Text -> Image
wrapText Int
w Attr
a Text
s])
(Int -> Attr -> Text -> [Image])
-> Behavior t Int -> Behavior t (Attr -> Text -> [Image])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int -> Behavior t Int
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Int
dw
Behavior t (Attr -> Text -> [Image])
-> Behavior t Attr -> Behavior t (Text -> [Image])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RichTextConfig t -> Behavior t Attr
forall k (t :: k). RichTextConfig t -> Behavior t Attr
_richTextConfig_attributes RichTextConfig t
cfg
Behavior t (Text -> [Image])
-> Behavior t Text -> Behavior t [Image]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Text
t
Behavior t [Image] -> m ()
forall k (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages Behavior t [Image]
img
where
wrapText :: Int -> Attr -> Text -> Image
wrapText Int
maxWidth Attr
attrs = [Image] -> Image
V.vertCat
([Image] -> Image) -> (Text -> [Image]) -> Text -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Image]) -> [Text] -> [Image]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> Image) -> [Text] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> String -> Image
V.string Attr
attrs (String -> Image) -> (Text -> String) -> Text -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> [Image]) -> (Text -> [Text]) -> Text -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Text -> [Text]
TZ.wrapWithOffset Int
maxWidth Int
0)
([Text] -> [Image]) -> (Text -> [Text]) -> Text -> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n')
text
:: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)
=> Behavior t Text
-> m ()
text :: Behavior t Text -> m ()
text Behavior t Text
t = do
Behavior t Attr
bt <- m (Behavior t Attr)
forall k (t :: k) (m :: * -> *).
HasTheme t m =>
m (Behavior t Attr)
theme
RichTextConfig t -> Behavior t Text -> m ()
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
RichTextConfig t -> Behavior t Text -> m ()
richText (Behavior t Attr -> RichTextConfig t
forall k (t :: k). Behavior t Attr -> RichTextConfig t
RichTextConfig Behavior t Attr
bt) Behavior t Text
t
display
:: (Reflex t, Monad m, Show a, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)
=> Behavior t a
-> m ()
display :: Behavior t a -> m ()
display Behavior t a
a = Behavior t Text -> m ()
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text (Behavior t Text -> m ()) -> Behavior t Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> Text) -> Behavior t a -> Behavior t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t a
a
scrollableText
:: forall t m. (Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasTheme t m, PostBuild t m)
=> ScrollableConfig t
-> Dynamic t Text
-> m (Scrollable t)
scrollableText :: ScrollableConfig t -> Dynamic t Text -> m (Scrollable t)
scrollableText ScrollableConfig t
cfg Dynamic t Text
t = do
ScrollableConfig t
-> m (Behavior t Image, Event t ()) -> m (Scrollable t)
forall k (t :: k) (m :: * -> *).
(Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m,
HasInput t m, HasImageWriter t m, HasTheme t m) =>
ScrollableConfig t
-> m (Behavior t Image, Event t ()) -> m (Scrollable t)
scrollable ScrollableConfig t
cfg (m (Behavior t Image, Event t ()) -> m (Scrollable t))
-> m (Behavior t Image, Event t ()) -> m (Scrollable t)
forall a b. (a -> b) -> a -> b
$ do
((), Behavior t [Image]
images) <- ImageWriter t m () -> m ((), Behavior t [Image])
forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
ImageWriter t m a -> m (a, Behavior t [Image])
runImageWriter (ImageWriter t m () -> m ((), Behavior t [Image]))
-> ImageWriter t m () -> m ((), Behavior t [Image])
forall a b. (a -> b) -> a -> b
$ Behavior t Text -> ImageWriter t m ()
forall k (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text (Dynamic t Text -> Behavior t Text
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
t)
(Behavior t Image, Event t ()) -> m (Behavior t Image, Event t ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Behavior t Image, Event t ())
-> m (Behavior t Image, Event t ()))
-> (Behavior t Image, Event t ())
-> m (Behavior t Image, Event t ())
forall a b. (a -> b) -> a -> b
$ ([Image] -> Image
V.vertCat ([Image] -> Image) -> Behavior t [Image] -> Behavior t Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t [Image]
images, () () -> Event t Text -> Event t ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Dynamic t Text -> Event t Text
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Text
t)