{-|
  Description: Text- and character-rendering widgets
-}
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 the background with a particular character.
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

-- | Configuration options for displaying "rich" text
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


-- TODO delete this and use new local theming
-- | A widget that displays text with custom time-varying attributes
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')

-- | Renders text, wrapped to the container width
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

-- | Renders any behavior whose value can be converted to
-- 'String' as text
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

-- | Scrollable text widget. The output exposes the current scroll position and
-- total number of lines (including those that are hidden)
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)