{-
 *  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 MultiWayIf      #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns    #-}

module Simple.UI.Widgets.TextListView (
    TextListView,
    TextListViewClass,
    castToTextListView,
    textListViewNew,
    textListViewCenterAt,
    textListViewReset,
    textListViewGetPos,
    textListViewGoUp,
    textListViewGoDown,
    textListViewUpdate,
    textItemActivated
) where

import           Control.Lens                  (makeLensesFor, (.=))
import           Control.Monad
import qualified Data.Vector                   as V
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.TextItem
import           Simple.UI.Widgets.Widget

data TextListView a = TextListView
    { _textListViewParent            :: Widget
    , _textListViewYOffset           :: Attribute Int
    , _textListViewPos               :: Attribute Int
    , _textListViewHeight            :: Attribute Int
    , _textListViewItems             :: Attribute (V.Vector (TextItem a))
    , _textListViewLength            :: Attribute Int
    , _textListViewTextItemActivated :: ListenerList (TextItem a -> UIApp' ())
    , _textListViewContentProvider   :: TextItem a -> Int -> UIApp' ()
    }

makeLensesFor [("_textListViewParent", "textListViewParent")] ''TextListView

class TextListViewClass w where
    castToTextListView :: w a -> TextListView a

    textItemActivated :: w a -> ListenerList (TextItem a -> UIApp' ())
    textItemActivated = _textListViewTextItemActivated . castToTextListView

    textListViewCenterAt :: w a -> Int -> Int -> UIApp u ()
    textListViewCenterAt _ _ 0 = return ()
    textListViewCenterAt (castToTextListView -> textListView) index listLength = do
        height <- get textListView _textListViewHeight
        let heightDivided = height `div` 2
        if | index <= heightDivided || listLength <= height -> do
                set textListView _textListViewPos index
                set textListView _textListViewYOffset 0
           | index + heightDivided < listLength -> do
                 let offset = index - heightDivided
                 set textListView _textListViewYOffset offset
                 set textListView _textListViewPos (index - offset)
           | otherwise -> do
                 let offset = listLength - height
                 set textListView _textListViewYOffset offset
                 set textListView _textListViewPos (index - offset)
                 return ()

    textListViewReset :: w a -> UIApp u ()
    textListViewReset (castToTextListView -> textListView) = do
        set textListView _textListViewPos 0
        set textListView _textListViewYOffset 0

    textListViewGetPos :: w a -> UIApp u Int
    textListViewGetPos (castToTextListView -> textListView) = do
        pos <- get textListView _textListViewPos
        yOffset <- get textListView _textListViewYOffset
        return (pos + yOffset)

    textListViewGoUp :: w a -> UIApp u ()
    textListViewGoUp = goUp . castToTextListView

    textListViewGoDown :: w a -> UIApp u ()
    textListViewGoDown = goDown . castToTextListView

    textListViewUpdate :: w a -> UIApp u ()
    textListViewUpdate = textListViewUpdateState . castToTextListView

instance TextListViewClass TextListView where
    castToTextListView = id

instance WidgetClass (TextListView a) where
    castToWidget = castToWidget . _textListViewParent

    overrideWidget = overrideWidgetHelper textListViewParent

textListViewNew :: (TextItem a -> Int -> UIApp' ()) -> UIApp u (TextListView a)
textListViewNew contentProvider = do
    textListView <- textListViewNewOverride contentProvider

    on_ textListView draw $ textListViewDraw textListView contentProvider
    on_ textListView keyPressed $ textListViewKeyPressed textListView

    return textListView

textListViewNewOverride :: (TextItem a -> Int -> UIApp' ()) -> UIApp u (TextListView a)
textListViewNewOverride contentProvider = override <$> textListViewNewDefault contentProvider
    where
      textListViewComputeSize _ = return (1, 1)

      override textView = overrideWidget textView $ do
          virtualWidgetName .= "textlistview"
          virtualWidgetComputeSize .= textListViewComputeSize textView

textListViewNewDefault :: (TextItem a -> Int -> UIApp' ()) -> UIApp u (TextListView a)
textListViewNewDefault contentProvider = do
    parent <- widgetNew

    yOffset <- attributeNew 0
    pos <- attributeNew 0
    height <- attributeNew 0
    items <- attributeNew V.empty
    l <- attributeNew 0
    itemActivated <- listenerNew

    return TextListView
        { _textListViewParent  = parent
        , _textListViewYOffset = yOffset
        , _textListViewPos = pos
        , _textListViewHeight  = height
        , _textListViewItems = items
        , _textListViewLength = l
        , _textListViewTextItemActivated = itemActivated
        , _textListViewContentProvider = contentProvider
        }

textListViewDraw :: TextListView a -> (TextItem a -> Int -> UIApp' ()) -> Drawing -> Int -> Int -> UIApp u ()
textListViewDraw textListView contentProvider drawing width height = do
    oldHeight <- get textListView _textListViewHeight
    when (height /= oldHeight) $ do
        _items <- V.generateM height $ \_ -> do
            item <- textItemNew Nothing
            getColors textListView >>= setColors item
            return item
        set textListView _textListViewItems _items
        set textListView _textListViewHeight height

    textListViewUpdateState textListView

    fg <- get textListView colorForeground
    bg <- get textListView colorBackground
    selectedBg <- get textListView colorBackgroundSelected
    drawingRun drawing $ do
        drawingSetAttrs fg bg DrawStyleNormal
        drawingClear

    pos <- get textListView _textListViewPos
    yOffset <- get textListView _textListViewYOffset
    items <- get textListView _textListViewItems
    forM_ [0 .. height - 1] $ \y -> do
        let item = items V.! y
        liftUIApp' $ contentProvider item (y + yOffset)
        drawing' <- drawingSliceNew drawing 0 y width 1
        if y == pos
            then set item colorBackground selectedBg
            else set item colorBackground bg
        fire item draw (drawing', width, 1 :: Int)

textListViewUpdateState :: TextListView a -> UIApp u ()
textListViewUpdateState textListView = do
    let contentProvider = _textListViewContentProvider textListView
    items <- get textListView _textListViewItems
    height <- get textListView _textListViewHeight
    yOffset <- get textListView _textListViewYOffset

    hasText <- forM [0 .. height - 1] $ \y -> do
        let item = items V.! y
        liftUIApp' $ contentProvider item (y + yOffset)

        maybeText <- get item text
        case maybeText of
            Just _  -> return True
            Nothing -> return False

    let listLength = length $ takeWhile (== True) hasText
    set textListView _textListViewLength listLength

    pos <- get textListView _textListViewPos
    when (pos > listLength - 1) $
        if yOffset > 0
            then set textListView _textListViewYOffset (yOffset - pos + listLength - 1)
            else set textListView _textListViewPos (listLength - 1)

    when (pos < 0 && listLength > 0) $ set textListView _textListViewPos 0


textListViewKeyPressed :: TextListView a -> Vty.Key -> [Vty.Modifier]-> UIApp u ()
textListViewKeyPressed textListView key _ = do
    height <- get textListView _textListViewHeight
    case key of
        Vty.KUp ->
            goUp textListView

        Vty.KDown ->
            goDown textListView

        Vty.KPageUp ->
            forM_ ([1..height `div` 2] :: [Int]) $ const (goUp textListView)

        Vty.KPageDown ->
            forM_ ([1..height `div` 2] :: [Int]) $ const (goDown textListView)

        Vty.KHome ->
            goHome textListView

        Vty.KEnd ->
            goEnd textListView

        Vty.KEnter -> do
            pos <- get textListView _textListViewPos
            when (pos >= 0) $ do
                items <- get textListView _textListViewItems
                fire textListView textItemActivated (items V.! pos)

        _ ->
            return ()

hasNthItem :: TextListView a -> Int -> UIApp u Bool
hasNthItem textListView pos = do
    let contentProvider = _textListViewContentProvider textListView
    item <- textItemNew Nothing
    liftUIApp' $ contentProvider item pos
    _text <- get item text
    case _text of
        Just _  -> return True
        Nothing -> return False

goUp :: TextListView a -> UIApp u ()
goUp textListView = do
    pos <- get textListView _textListViewPos
    yOffset <- get textListView _textListViewYOffset
    if pos > 0
        then
            set textListView _textListViewPos (pos - 1)
        else
            when (yOffset > 0) $
                modify textListView _textListViewYOffset pred

goDown :: TextListView a -> UIApp u ()
goDown textListView = do
    l <- get textListView _textListViewLength
    pos <- get textListView _textListViewPos
    yOffset <- get textListView _textListViewYOffset
    if l > pos + 1
        then
            set textListView _textListViewPos (pos + 1)
        else do
            hasItem <- hasNthItem textListView (pos + yOffset + 1)
            when hasItem $
                modify textListView _textListViewYOffset succ

goHome :: TextListView a -> UIApp u ()
goHome textListView = do
    set textListView _textListViewPos 0
    set textListView _textListViewYOffset 0

goEnd :: TextListView a -> UIApp u ()
goEnd textListView = do
    pos <- get textListView _textListViewPos
    yOffset <- get textListView _textListViewYOffset
    goDown textListView
    pos' <- get textListView _textListViewPos
    yOffset' <- get textListView _textListViewYOffset
    when (pos + yOffset /= pos' + yOffset') $
        goEnd textListView