{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2017 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
{-# LANGUAGE TemplateHaskell #-}

module Simple.UI.Widgets.TextView (
    TextView,
    TextViewClass,
    castToTextView,
    textViewNew
) where

import           Control.Lens                  (makeLensesFor, (.=))
import           Control.Monad
import qualified Graphics.Vty                  as Vty

import           Simple.UI.Core.Internal.UIApp

import           Simple.UI.Core.Attribute
import           Simple.UI.Core.Draw
import           Simple.UI.Core.ListenerList
import           Simple.UI.Widgets.Text
import           Simple.UI.Widgets.Widget

data TextView = TextView
    { TextView -> Text
_textViewParent  :: Text
    , TextView -> Attribute Int
_textViewYOffset :: Attribute Int
    , TextView -> Attribute Int
_textViewHeight  :: Attribute Int
    }

makeLensesFor [("_textViewParent", "textViewParent")] ''TextView

class TextClass w => TextViewClass w where
    castToTextView :: w -> TextView

instance TextViewClass TextView where
    castToTextView :: TextView -> TextView
castToTextView = TextView -> TextView
forall a. a -> a
id

instance TextClass TextView where
    castToText :: TextView -> Text
castToText = TextView -> Text
_textViewParent

instance WidgetClass TextView where
    castToWidget :: TextView -> Widget
castToWidget = Text -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget (Text -> Widget) -> (TextView -> Text) -> TextView -> Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextView -> Text
_textViewParent

    overrideWidget :: TextView -> State VirtualWidget () -> TextView
overrideWidget = Lens' TextView Text
-> TextView -> State VirtualWidget () -> TextView
forall p w.
WidgetClass p =>
Lens' w p -> w -> State VirtualWidget () -> w
overrideWidgetHelper Lens' TextView Text
textViewParent

textViewNew :: Maybe String -> UIApp u TextView
textViewNew :: Maybe String -> UIApp u TextView
textViewNew Maybe String
s = do
    TextView
textView <- Maybe String -> UIApp u TextView
forall u. Maybe String -> UIApp u TextView
textViewNewOverride Maybe String
s

    TextView
-> (TextView -> ListenerList (Drawing -> Int -> Int -> UIApp' ()))
-> (Drawing -> Int -> Int -> UIApp' ())
-> UIApp u ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ TextView
textView TextView -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
draw ((Drawing -> Int -> Int -> UIApp' ()) -> UIApp u ())
-> (Drawing -> Int -> Int -> UIApp' ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ TextView -> Drawing -> Int -> Int -> UIApp' ()
forall u. TextView -> Drawing -> Int -> Int -> UIApp u ()
textViewDraw TextView
textView
    TextView
-> (TextView -> ListenerList (Key -> [Modifier] -> UIApp' ()))
-> (Key -> [Modifier] -> UIApp' ())
-> UIApp u ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ TextView
textView TextView -> ListenerList (Key -> [Modifier] -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Key -> [Modifier] -> UIApp' ())
keyPressed ((Key -> [Modifier] -> UIApp' ()) -> UIApp u ())
-> (Key -> [Modifier] -> UIApp' ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ TextView -> Key -> [Modifier] -> UIApp' ()
forall u. TextView -> Key -> [Modifier] -> UIApp u ()
textViewKeyPressed TextView
textView

    TextView -> UIApp u TextView
forall (m :: * -> *) a. Monad m => a -> m a
return TextView
textView

textViewNewOverride :: Maybe String -> UIApp u TextView
textViewNewOverride :: Maybe String -> UIApp u TextView
textViewNewOverride Maybe String
s = TextView -> TextView
forall w. TextClass w => w -> w
override (TextView -> TextView) -> UIApp u TextView -> UIApp u TextView
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> UIApp u TextView
forall u. Maybe String -> UIApp u TextView
textViewNewDefault Maybe String
s
    where
      textViewComputeSize :: w -> m (Int, Int)
textViewComputeSize w
textView = do
          Maybe String
maybeText <- w -> (w -> Attribute (Maybe String)) -> m (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get w
textView w -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text

          case Maybe String
maybeText of
              Maybe String
Nothing -> (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1, Int
1)
              Just String
_text -> do
                  let ls :: [String]
ls = String -> [String]
lines String
_text
                  let ws :: [Int]
ws = (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls

                  let w :: Int
w = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ws
                  let l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls

                  (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ( if Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
1 else Int
w
                         , if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
1 else Int
l
                         )

      override :: w -> w
override w
textView = w -> State VirtualWidget () -> w
forall w. WidgetClass w => w -> State VirtualWidget () -> w
overrideWidget w
textView (State VirtualWidget () -> w) -> State VirtualWidget () -> w
forall a b. (a -> b) -> a -> b
$ do
          (String -> Identity String)
-> VirtualWidget -> Identity VirtualWidget
Lens' VirtualWidget String
virtualWidgetName ((String -> Identity String)
 -> VirtualWidget -> Identity VirtualWidget)
-> String -> State VirtualWidget ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String
"textview"
          (UIApp' (Int, Int) -> Identity (UIApp' (Int, Int)))
-> VirtualWidget -> Identity VirtualWidget
Lens' VirtualWidget (UIApp' (Int, Int))
virtualWidgetComputeSize ((UIApp' (Int, Int) -> Identity (UIApp' (Int, Int)))
 -> VirtualWidget -> Identity VirtualWidget)
-> UIApp' (Int, Int) -> State VirtualWidget ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= w -> UIApp' (Int, Int)
forall (m :: * -> *) w.
(MonadIO m, TextClass w) =>
w -> m (Int, Int)
textViewComputeSize w
textView

textViewNewDefault :: Maybe String -> UIApp u TextView
textViewNewDefault :: Maybe String -> UIApp u TextView
textViewNewDefault Maybe String
s = do
    Text
parent <- Maybe String -> UIApp u Text
forall u. Maybe String -> UIApp u Text
textNew Maybe String
s

    Attribute Int
yOffset <- Int -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Int
0
    Attribute Int
height <- Int -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Int
0

    TextView -> UIApp u TextView
forall (m :: * -> *) a. Monad m => a -> m a
return TextView :: Text -> Attribute Int -> Attribute Int -> TextView
TextView
        { _textViewParent :: Text
_textViewParent  = Text
parent
        , _textViewYOffset :: Attribute Int
_textViewYOffset = Attribute Int
yOffset
        , _textViewHeight :: Attribute Int
_textViewHeight  = Attribute Int
height
        }

textViewDraw :: TextView -> Drawing -> Int -> Int -> UIApp u ()
textViewDraw :: TextView -> Drawing -> Int -> Int -> UIApp u ()
textViewDraw TextView
textView Drawing
drawing Int
_ Int
height = do
    TextView -> (TextView -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set TextView
textView TextView -> Attribute Int
_textViewHeight Int
height
    Maybe String
maybeText <- TextView
-> (TextView -> Attribute (Maybe String))
-> ReaderT (AppConfig u) (StateT AppState IO) (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text

    Maybe String -> (String -> UIApp u ()) -> UIApp u ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
maybeText ((String -> UIApp u ()) -> UIApp u ())
-> (String -> UIApp u ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ \String
_text -> do
        Color
fg <- TextView
-> (TextView -> Attribute Color)
-> ReaderT (AppConfig u) (StateT AppState IO) Color
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorForeground
        Color
bg <- TextView
-> (TextView -> Attribute Color)
-> ReaderT (AppConfig u) (StateT AppState IO) Color
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorBackground
        DrawStyle
style <- TextView
-> (TextView -> Attribute DrawStyle)
-> ReaderT (AppConfig u) (StateT AppState IO) DrawStyle
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute DrawStyle
forall w. WidgetClass w => w -> Attribute DrawStyle
colorStyle

        let ls :: [String]
ls = String -> [String]
lines String
_text
        let l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls

        Int
yOffset' <- TextView
-> (TextView -> Attribute Int)
-> ReaderT (AppConfig u) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute Int
_textViewYOffset
        let yOffset :: Int
yOffset = if Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yOffset' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l
                          then Int -> Int
nat (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height
                          else Int
yOffset'

        Drawing -> DrawingBuilder () -> UIApp u ()
forall (m :: * -> *) a.
MonadIO m =>
Drawing -> DrawingBuilder a -> m a
drawingRun Drawing
drawing (DrawingBuilder () -> UIApp u ())
-> DrawingBuilder () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ do
            let minH :: Int
minH = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
height Int
l
            let h :: Int
h = Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
            let dy :: Int
dy = if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Int
0 else Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

            Color -> Color -> DrawStyle -> DrawingBuilder ()
drawingSetAttrs Color
fg Color
bg DrawStyle
style
            DrawingBuilder ()
drawingClear
            [(Int, Int)]
-> ((Int, Int) -> DrawingBuilder ()) -> DrawingBuilder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
dy..] [Int
0 .. Int
minH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) (((Int, Int) -> DrawingBuilder ()) -> DrawingBuilder ())
-> ((Int, Int) -> DrawingBuilder ()) -> DrawingBuilder ()
forall a b. (a -> b) -> a -> b
$ \(Int
y, Int
i) ->
                Int -> Int -> String -> DrawingBuilder ()
drawingPutString Int
0 Int
y ([String]
ls [String] -> Int -> String
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yOffset))

textViewKeyPressed :: TextView -> Vty.Key -> [Vty.Modifier]-> UIApp u ()
textViewKeyPressed :: TextView -> Key -> [Modifier] -> UIApp u ()
textViewKeyPressed TextView
textView Key
key [Modifier]
_ = do
    Int
height <- TextView
-> (TextView -> Attribute Int)
-> ReaderT (AppConfig u) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute Int
_textViewHeight
    Int
yOffset <- TextView
-> (TextView -> Attribute Int)
-> ReaderT (AppConfig u) (StateT AppState IO) Int
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute Int
_textViewYOffset

    case Key
key of
        Key
Vty.KUp ->
            Bool -> UIApp u () -> UIApp u ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
yOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (UIApp u () -> UIApp u ()) -> UIApp u () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$
                TextView -> (TextView -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set TextView
textView TextView -> Attribute Int
_textViewYOffset (Int
yOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

        Key
Vty.KDown -> do
            Maybe String
maybeText <- TextView
-> (TextView -> Attribute (Maybe String))
-> ReaderT (AppConfig u) (StateT AppState IO) (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text
            Maybe String -> (String -> UIApp u ()) -> UIApp u ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
maybeText ((String -> UIApp u ()) -> UIApp u ())
-> (String -> UIApp u ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ \String
_text -> do
                let l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
_text
                Bool -> UIApp u () -> UIApp u ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
yOffset) (UIApp u () -> UIApp u ()) -> UIApp u () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$
                    TextView -> (TextView -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set TextView
textView TextView -> Attribute Int
_textViewYOffset (Int
yOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

        Key
Vty.KPageUp ->
            if Int
yOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5
                then TextView -> (TextView -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set TextView
textView TextView -> Attribute Int
_textViewYOffset (Int
yOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)
                else TextView -> (TextView -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set TextView
textView TextView -> Attribute Int
_textViewYOffset Int
0

        Key
Vty.KPageDown -> do
            Maybe String
maybeText <- TextView
-> (TextView -> Attribute (Maybe String))
-> ReaderT (AppConfig u) (StateT AppState IO) (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextView
textView TextView -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text
            Maybe String -> (String -> UIApp u ()) -> UIApp u ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
maybeText ((String -> UIApp u ()) -> UIApp u ())
-> (String -> UIApp u ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ \String
_text -> do
                let l :: Int
l = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
_text
                if Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
yOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5
                    then TextView -> (TextView -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set TextView
textView TextView -> Attribute Int
_textViewYOffset (Int
yOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
                    else TextView -> (TextView -> Attribute Int) -> Int -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set TextView
textView TextView -> Attribute Int
_textViewYOffset (Int -> Int
nat (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
height)

        Key
_ ->
            () -> UIApp u ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

nat :: Int -> Int
nat :: Int -> Int
nat Int
x = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
0 else Int
x