{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2018 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 LambdaCase      #-}
{-# LANGUAGE TemplateHaskell #-}

module Simple.UI.Widgets.Edit (
    Edit,
    EditClass,
    castToEdit,
    editNew,
    text
) where

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

import           Simple.UI.Core.Attribute
import           Simple.UI.Core.Draw
import           Simple.UI.Core.Internal.UIApp
import           Simple.UI.Core.ListenerList
import           Simple.UI.Utils
import           Simple.UI.Widgets.Text
import           Simple.UI.Widgets.Widget

data Edit = Edit
    { _editParent    :: Text
    , _editCursorPos :: Attribute Int
    , _editXOffset   :: Attribute Int
    , _editWidth     :: Attribute Int
    }

makeLensesFor [("_editParent", "editParent")] ''Edit

class TextClass w => EditClass w where
    castToEdit :: w -> Edit

instance EditClass Edit where
    castToEdit = id

instance TextClass Edit where
    castToText = _editParent

instance WidgetClass Edit where
    castToWidget = castToWidget . _editParent

    overrideWidget = overrideWidgetHelper editParent

editNew :: Maybe String -> UIApp u Edit
editNew s = do
    edit <- editNewOverride s

    on_ edit draw $ editDraw edit
    on_ edit keyPressed $ \key _ ->
        case key of
            Vty.KChar c -> do
                pos <- get edit _editCursorPos
                offset <- get edit _editXOffset
                modify edit text $ \case
                    Nothing -> Just [c]
                    Just x  -> Just $ insertAt (pos + offset) x c
                cursorGoRight edit

            Vty.KBS -> do
                pos <- get edit _editCursorPos
                offset <- get edit _editXOffset
                modify edit text $ \case
                    Nothing -> Nothing
                    Just x  -> do
                        let x' = removeAt (pos + offset - 1) x
                        if null x' then Nothing else Just x'
                cursorGoLeft edit

            Vty.KDel -> do
                pos <- get edit _editCursorPos
                offset <- get edit _editXOffset
                modify edit text $ \case
                    Nothing -> Nothing
                    Just x  -> do
                        let x' = removeAt (pos + offset) x
                        if null x' then Nothing else Just x'

            Vty.KHome -> do
                modify edit _editCursorPos $ const 0
                modify edit _editXOffset $ const 0

            Vty.KEnd -> do
                _text <- get edit text
                forM_ _text $ \x -> do
                    width <- pred <$> get edit _editWidth
                    if length x > width
                        then do
                            modify edit _editCursorPos $ const width
                            modify edit _editXOffset $ const (length x - width)
                        else do
                            modify edit _editCursorPos $ const (length x)
                            modify edit _editXOffset $ const 0

            Vty.KLeft ->
                cursorGoLeft edit

            Vty.KRight ->
                cursorGoRight edit

            _  ->
                return ()

    return edit
  where
    cursorGoRight edit = do
        _text <- get edit text
        forM_ _text $ \x -> do
            width  <- pred <$> get edit _editWidth
            pos    <- get edit _editCursorPos
            offset <- get edit _editXOffset

            let (newPos, newOffset) =
                    if pos + 1 > width
                        then
                            if pos + offset + 1 > length x
                                then
                                    (pos, offset)
                                else
                                    (pos, offset + 1)
                        else
                            (pos + 1, offset)

            set edit _editCursorPos newPos
            set edit _editXOffset newOffset

    cursorGoLeft edit = do
        _text <- get edit text
        forM_ _text $ \_ -> do
            pos    <- get edit _editCursorPos
            offset <- get edit _editXOffset

            let (newPos, newOffset) =
                    if pos - 1 < 0
                        then
                            if offset > 0
                                then
                                    (0, offset - 1)
                                else
                                    (0, 0)
                        else
                            (pos - 1, offset)

            set edit _editCursorPos newPos
            set edit _editXOffset newOffset

editNewOverride :: Maybe String -> UIApp u Edit
editNewOverride s = override <$> editNewDefault s
  where
    editComputeSize edit = do
        maybeText <- get edit text
        case maybeText of
            Nothing    -> return (1, 1)
            Just _text -> do
                let width = if length _text < 2 then 2 else length _text
                return (width ,1)

    override edit = overrideWidget edit $ do
        virtualWidgetName .= "edit"
        virtualWidgetComputeSize .= editComputeSize edit

editNewDefault :: Maybe String -> UIApp u Edit
editNewDefault s = do
    parent <- textNew s
    pos <- attributeNew $ length s
    offset <- attributeNew 0
    width <- attributeNew 1

    return Edit
        { _editParent = parent
        , _editCursorPos = pos
        , _editXOffset = offset
        , _editWidth = width
        }

editDraw :: Edit -> Drawing -> Int -> Int -> UIApp u ()
editDraw edit drawing width _ = do
    set edit _editWidth width

    maybeText <- get edit text

    fg <- get edit colorForeground
    bg <- get edit colorBackground
    style <- get edit colorStyle

    drawingRun drawing $ do
        drawingSetAttrs fg bg style
        drawingClear
        case maybeText of
            Just _text -> do
                pos <- get edit _editCursorPos
                offset <- get edit _editXOffset

                let s = drop offset _text
                forM_ (zip (s ++ " ") [0..]) $ \(c, i) ->
                    if pos == i
                        then drawingPutCharWithAttr bg fg style i 0 c
                        else drawingPutChar i 0 c

            Nothing ->
                drawingPutCharWithAttr bg fg style 0 0 ' '