{-
 *  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.SimpleMenuItem (
    SimpleMenuItem,
    SimpleMenuItemClass,
    castToSimpleMenuItem,
    simpleMenuItemNew,
    menuItemChar,
    menuItemActivate,
    activated
) where

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

import           Control.Monad

import           Simple.UI.Core.Attribute
import           Simple.UI.Core.ListenerList
import           Simple.UI.Core.UIApp
import           Simple.UI.Layouts.FillLayout
import           Simple.UI.Widgets.Container
import           Simple.UI.Widgets.Label
import           Simple.UI.Widgets.Properties.Selected
import           Simple.UI.Widgets.Text
import           Simple.UI.Widgets.Widget

data SimpleMenuItem = SimpleMenuItem
    { SimpleMenuItem -> Widget
_simpleMenuItemParent    :: Widget
    , SimpleMenuItem -> Char
_simpleMenuItemChar      :: Char
    , SimpleMenuItem -> ListenerList (UIApp' ())
_simpleMenuItemActivated :: ListenerList (UIApp' ())
    , SimpleMenuItem -> Attribute Bool
_simpleMenuItemSelected  :: Attribute Bool
    }

makeLensesFor [("_simpleMenuItemParent", "simpleMenuItemParent")] ''SimpleMenuItem

class WidgetClass w => SimpleMenuItemClass w where
    castToSimpleMenuItem :: w -> SimpleMenuItem

    menuItemChar :: w -> Char
    menuItemChar = SimpleMenuItem -> Char
_simpleMenuItemChar (SimpleMenuItem -> Char) -> (w -> SimpleMenuItem) -> w -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> SimpleMenuItem
forall w. SimpleMenuItemClass w => w -> SimpleMenuItem
castToSimpleMenuItem

    activated :: w -> ListenerList (UIApp' ())
    activated = SimpleMenuItem -> ListenerList (UIApp' ())
_simpleMenuItemActivated (SimpleMenuItem -> ListenerList (UIApp' ()))
-> (w -> SimpleMenuItem) -> w -> ListenerList (UIApp' ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> SimpleMenuItem
forall w. SimpleMenuItemClass w => w -> SimpleMenuItem
castToSimpleMenuItem

    menuItemActivate :: w -> UIApp u ()
    menuItemActivate w
item = SimpleMenuItem
-> (SimpleMenuItem -> ListenerList (UIApp' ())) -> () -> UIApp u ()
forall a b w u.
Fire a b =>
w -> (w -> ListenerList a) -> b -> UIApp u ()
fire (w -> SimpleMenuItem
forall w. SimpleMenuItemClass w => w -> SimpleMenuItem
castToSimpleMenuItem w
item) SimpleMenuItem -> ListenerList (UIApp' ())
forall w. SimpleMenuItemClass w => w -> ListenerList (UIApp' ())
activated ()

instance WidgetClass SimpleMenuItem where
    castToWidget :: SimpleMenuItem -> Widget
castToWidget = SimpleMenuItem -> Widget
_simpleMenuItemParent

    overrideWidget :: SimpleMenuItem -> State VirtualWidget () -> SimpleMenuItem
overrideWidget = Lens' SimpleMenuItem Widget
-> SimpleMenuItem -> State VirtualWidget () -> SimpleMenuItem
forall p w.
WidgetClass p =>
Lens' w p -> w -> State VirtualWidget () -> w
overrideWidgetHelper Lens' SimpleMenuItem Widget
simpleMenuItemParent

instance SimpleMenuItemClass SimpleMenuItem where
    castToSimpleMenuItem :: SimpleMenuItem -> SimpleMenuItem
castToSimpleMenuItem = SimpleMenuItem -> SimpleMenuItem
forall a. a -> a
id

instance HasSelected SimpleMenuItem where
    selected :: SimpleMenuItem -> Attribute Bool
selected = SimpleMenuItem -> Attribute Bool
_simpleMenuItemSelected

simpleMenuItemNew :: Char -> String -> UIApp u SimpleMenuItem
simpleMenuItemNew :: Char -> String -> UIApp u SimpleMenuItem
simpleMenuItemNew Char
c String
s = do
    ListenerList (UIApp' ())
a <- ReaderT
  (AppConfig u) (StateT AppState IO) (ListenerList (UIApp' ()))
forall (m :: * -> *) a. MonadIO m => m (ListenerList a)
listenerNew

    FillLayout
_layout <- UIApp u FillLayout
forall u. UIApp u FillLayout
fillLayoutHorizontalNew
    Container FillLayout
container <- FillLayout -> UIApp u (Container FillLayout)
forall a u. LayoutClass a => a -> UIApp u (Container a)
containerNew FillLayout
_layout

    Label
l1 <- Maybe String -> UIApp u Label
forall u. Maybe String -> UIApp u Label
labelNew (Maybe String -> UIApp u Label) -> Maybe String -> UIApp u Label
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] "
    Label
l2 <- Maybe String -> UIApp u Label
forall u. Maybe String -> UIApp u Label
labelNew (Maybe String -> UIApp u Label) -> Maybe String -> UIApp u Label
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
    Label
-> (Label -> Attribute TextAlign)
-> TextAlign
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Label
l2 Label -> Attribute TextAlign
forall w. TextClass w => w -> Attribute TextAlign
align TextAlign
TextAlignLeft

    Container FillLayout
-> Label
-> LayoutData FillLayout
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (w :: * -> *) u (m :: * -> *) a.
(ContainerClass w, WidgetClass u, MonadIO m) =>
w a -> u -> LayoutData a -> m ()
addTo Container FillLayout
container Label
l1 FillLayoutData
forall a. Default a => a
def { fillLayoutHExpand :: Bool
fillLayoutHExpand = Bool
False }
    Container FillLayout
-> Label
-> LayoutData FillLayout
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (w :: * -> *) u (m :: * -> *) a.
(ContainerClass w, WidgetClass u, MonadIO m) =>
w a -> u -> LayoutData a -> m ()
addTo Container FillLayout
container Label
l2 LayoutData FillLayout
forall a. Default a => a
def

    Attribute Bool
sel <- Bool -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Bool
False

    let _simpleMenuItem :: SimpleMenuItem
_simpleMenuItem = SimpleMenuItem :: Widget
-> Char
-> ListenerList (UIApp' ())
-> Attribute Bool
-> SimpleMenuItem
SimpleMenuItem
            { _simpleMenuItemParent :: Widget
_simpleMenuItemParent = Container FillLayout -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget Container FillLayout
container --parent
            , _simpleMenuItemChar :: Char
_simpleMenuItemChar = Char
c
            , _simpleMenuItemActivated :: ListenerList (UIApp' ())
_simpleMenuItemActivated = ListenerList (UIApp' ())
a
            , _simpleMenuItemSelected :: Attribute Bool
_simpleMenuItemSelected = Attribute Bool
sel
            }

    let simpleMenuItem :: SimpleMenuItem
simpleMenuItem = SimpleMenuItem -> State VirtualWidget () -> SimpleMenuItem
forall w. WidgetClass w => w -> State VirtualWidget () -> w
overrideWidget SimpleMenuItem
_simpleMenuItem (State VirtualWidget () -> SimpleMenuItem)
-> State VirtualWidget () -> SimpleMenuItem
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
"simplemenuitem"

    SimpleMenuItem
simpleMenuItem SimpleMenuItem
-> Label -> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w v u.
(WidgetClass w, WidgetClass v) =>
w -> v -> UIApp u ()
`connectColorsTo` Label
l1
    SimpleMenuItem
simpleMenuItem SimpleMenuItem
-> Label -> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w v u.
(WidgetClass w, WidgetClass v) =>
w -> v -> UIApp u ()
`connectColorsTo` Label
l2

    Label
-> (Label -> ListenerList (Drawing -> Int -> Int -> UIApp' ()))
-> (Drawing -> Int -> Int -> UIApp' ())
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ Label
l1 Label -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
draw ((Drawing -> Int -> Int -> UIApp' ())
 -> ReaderT (AppConfig u) (StateT AppState IO) ())
-> (Drawing -> Int -> Int -> UIApp' ())
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall a b. (a -> b) -> a -> b
$ \Drawing
_ Int
_ Int
_ -> SimpleMenuItem -> Label -> UIApp' ()
forall w w u.
(HasSelected w, WidgetClass w) =>
w -> w -> ReaderT (AppConfig u) (StateT AppState IO) ()
labelSetColor SimpleMenuItem
simpleMenuItem Label
l1
    Label
-> (Label -> ListenerList (Drawing -> Int -> Int -> UIApp' ()))
-> (Drawing -> Int -> Int -> UIApp' ())
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ Label
l2 Label -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
draw ((Drawing -> Int -> Int -> UIApp' ())
 -> ReaderT (AppConfig u) (StateT AppState IO) ())
-> (Drawing -> Int -> Int -> UIApp' ())
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall a b. (a -> b) -> a -> b
$ \Drawing
_ Int
_ Int
_ -> SimpleMenuItem -> Label -> UIApp' ()
forall w w u.
(HasSelected w, WidgetClass w) =>
w -> w -> ReaderT (AppConfig u) (StateT AppState IO) ()
labelSetColor SimpleMenuItem
simpleMenuItem Label
l2

    SimpleMenuItem
-> (SimpleMenuItem
    -> ListenerList (Key -> [Modifier] -> UIApp' ()))
-> (Key -> [Modifier] -> UIApp' ())
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ SimpleMenuItem
simpleMenuItem SimpleMenuItem -> ListenerList (Key -> [Modifier] -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Key -> [Modifier] -> UIApp' ())
keyPressed ((Key -> [Modifier] -> UIApp' ())
 -> ReaderT (AppConfig u) (StateT AppState IO) ())
-> (Key -> [Modifier] -> UIApp' ())
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall a b. (a -> b) -> a -> b
$ \Key
key [Modifier]
_ ->
        Bool -> UIApp' () -> UIApp' ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char -> Key
Vty.KChar Char
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key) (UIApp' () -> UIApp' ()) -> UIApp' () -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ SimpleMenuItem
-> (SimpleMenuItem -> ListenerList (UIApp' ())) -> () -> UIApp' ()
forall a b w u.
Fire a b =>
w -> (w -> ListenerList a) -> b -> UIApp u ()
fire SimpleMenuItem
simpleMenuItem SimpleMenuItem -> ListenerList (UIApp' ())
forall w. SimpleMenuItemClass w => w -> ListenerList (UIApp' ())
activated ()

    SimpleMenuItem -> UIApp u SimpleMenuItem
forall (m :: * -> *) a. Monad m => a -> m a
return SimpleMenuItem
simpleMenuItem
  where
    labelSetColor :: w -> w -> ReaderT (AppConfig u) (StateT AppState IO) ()
labelSetColor w
simpleMenuItem w
label = do
        (Color
fg, Color
bg, DrawStyle
style) <- w -> UIApp u (Color, Color, DrawStyle)
forall w u. HasSelected w => w -> UIApp u (Color, Color, DrawStyle)
selectedGetColors w
simpleMenuItem
        w
-> (w -> Attribute Color)
-> Color
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set w
label w -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorForeground Color
fg
        w
-> (w -> Attribute Color)
-> Color
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set w
label w -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorBackground Color
bg
        w
-> (w -> Attribute DrawStyle)
-> DrawStyle
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set w
label w -> Attribute DrawStyle
forall w. WidgetClass w => w -> Attribute DrawStyle
colorStyle DrawStyle
style