{-
 *  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.TextItem (
    TextItem,
    TextItemClass,
    castToTextItem,
    textItemNew,
    itemData
) where

import           Control.Lens                          (makeLensesFor, (.=))
import           Control.Monad                         (forM_)

import           Simple.UI.Core.Attribute
import           Simple.UI.Core.Draw
import           Simple.UI.Core.ListenerList
import           Simple.UI.Core.UIApp
import           Simple.UI.Widgets.Properties.Selected
import           Simple.UI.Widgets.Text
import           Simple.UI.Widgets.Widget

data TextItem a = TextItem
    { TextItem a -> Text
_textItemParent   :: Text
    , TextItem a -> Attribute (Maybe a)
_textItemData     :: Attribute (Maybe a)
    , TextItem a -> Attribute Bool
_textItemSelected :: Attribute Bool
    }

makeLensesFor [("_textItemParent", "textItemParent")] ''TextItem

class TextItemClass w where
    castToTextItem :: w a -> TextItem a

    itemData :: w a -> Attribute (Maybe a)
    itemData = TextItem a -> Attribute (Maybe a)
forall a. TextItem a -> Attribute (Maybe a)
_textItemData (TextItem a -> Attribute (Maybe a))
-> (w a -> TextItem a) -> w a -> Attribute (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w a -> TextItem a
forall (w :: * -> *) a. TextItemClass w => w a -> TextItem a
castToTextItem

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

    overrideWidget :: TextItem a -> State VirtualWidget () -> TextItem a
overrideWidget = Lens' (TextItem a) Text
-> TextItem a -> State VirtualWidget () -> TextItem a
forall p w.
WidgetClass p =>
Lens' w p -> w -> State VirtualWidget () -> w
overrideWidgetHelper forall a. Lens' (TextItem a) Text
Lens' (TextItem a) Text
textItemParent

instance TextClass (TextItem a) where
    castToText :: TextItem a -> Text
castToText = Text -> Text
forall w. TextClass w => w -> Text
castToText (Text -> Text) -> (TextItem a -> Text) -> TextItem a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextItem a -> Text
forall a. TextItem a -> Text
_textItemParent

instance TextItemClass TextItem where
    castToTextItem :: TextItem a -> TextItem a
castToTextItem = TextItem a -> TextItem a
forall a. a -> a
id

instance HasSelected (TextItem a) where
    selected :: TextItem a -> Attribute Bool
selected = TextItem a -> Attribute Bool
forall a. TextItem a -> Attribute Bool
_textItemSelected

textItemNew :: Maybe String -> UIApp u (TextItem a)
textItemNew :: Maybe String -> UIApp u (TextItem a)
textItemNew Maybe String
s = do
    Text
parent <- Maybe String -> UIApp u Text
forall u. Maybe String -> UIApp u Text
textNew Maybe String
s
    Attribute Bool
sel <- Bool -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Bool
False
    Attribute (Maybe a)
d <- Maybe a
-> ReaderT (AppConfig u) (StateT AppState IO) (Attribute (Maybe a))
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Maybe a
forall a. Maybe a
Nothing

    let textItem :: TextItem a
textItem = TextItem a -> State VirtualWidget () -> TextItem a
forall w. WidgetClass w => w -> State VirtualWidget () -> w
overrideWidget
                       TextItem :: forall a.
Text -> Attribute (Maybe a) -> Attribute Bool -> TextItem a
TextItem { _textItemParent :: Text
_textItemParent = Text
parent
                                , _textItemData :: Attribute (Maybe a)
_textItemData = Attribute (Maybe a)
d
                                , _textItemSelected :: Attribute Bool
_textItemSelected = Attribute Bool
sel
                                }
                   (State VirtualWidget () -> TextItem a)
-> State VirtualWidget () -> TextItem a
forall a b. (a -> b) -> a -> b
$ (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
"textitem"

    ListenerID
_ <- TextItem a
-> (TextItem a
    -> ListenerList (Drawing -> Int -> Int -> UIApp' ()))
-> (Drawing -> Int -> Int -> UIApp' ())
-> UIApp u ListenerID
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ListenerID
on TextItem a
textItem TextItem a -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
draw ((Drawing -> Int -> Int -> UIApp' ()) -> UIApp u ListenerID)
-> (Drawing -> Int -> Int -> UIApp' ()) -> UIApp u ListenerID
forall a b. (a -> b) -> a -> b
$ TextItem a -> Drawing -> Int -> Int -> UIApp' ()
forall a u. TextItem a -> Drawing -> Int -> Int -> UIApp u ()
textItemDraw TextItem a
textItem

    TextItem a -> UIApp u (TextItem a)
forall (m :: * -> *) a. Monad m => a -> m a
return TextItem a
textItem

textItemDraw :: TextItem a -> Drawing -> Int -> Int -> UIApp u ()
textItemDraw :: TextItem a -> Drawing -> Int -> Int -> UIApp u ()
textItemDraw TextItem a
item Drawing
drawing Int
width Int
_ = do
    Maybe String
maybeText <- TextItem a
-> (TextItem a -> Attribute (Maybe String))
-> ReaderT (AppConfig u) (StateT AppState IO) (Maybe String)
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextItem a
item TextItem a -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text

    (Color
fg, Color
bg, DrawStyle
style) <- TextItem a -> UIApp u (Color, Color, DrawStyle)
forall w u. HasSelected w => w -> UIApp u (Color, Color, DrawStyle)
selectedGetColors TextItem a
item
    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
        Color -> Color -> DrawStyle -> DrawingBuilder ()
drawingSetAttrs Color
fg Color
bg DrawStyle
style
        DrawingBuilder ()
drawingClear

    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 ->
        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
            TextAlign
_align <- TextItem a
-> (TextItem a -> Attribute TextAlign)
-> ReaderT Drawing IO TextAlign
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get TextItem a
item TextItem a -> Attribute TextAlign
forall w. TextClass w => w -> Attribute TextAlign
align
            case TextAlign
_align of
                TextAlign
TextAlignLeft   -> Int -> Int -> String -> DrawingBuilder ()
drawingPutString Int
0 Int
0 String
_text
                TextAlign
TextAlignRight  -> Int -> Int -> String -> DrawingBuilder ()
drawingPutString (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
_text) Int
0 String
_text
                TextAlign
TextAlignCenter -> Int -> Int -> String -> DrawingBuilder ()
drawingPutString ((Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
_text) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int
0 String
_text