{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Simple.UI.Widgets.SimpleMenuBar (
SimpleMenuBar,
SimpleMenuBarClass,
castToSimpleMenuBar,
simpleMenuBarNew,
menuBarItemAdd
) where
import Control.Lens (makeLensesFor, (.=))
import Control.Monad
import qualified Graphics.Vty as Vty
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.Properties.Selected
import Simple.UI.Widgets.SimpleMenuItem
import Simple.UI.Widgets.Widget
data SimpleMenuBar = SimpleMenuBar
{ _simpleMenuBarParent :: Widget
, _simpleMenuBarContainer :: Container FillLayout
, _simpleMenuBarItems :: AttributeList SimpleMenuItem
}
makeLensesFor [("_simpleMenuBarParent", "simpleMenuBarParent")] ''SimpleMenuBar
class WidgetClass w => SimpleMenuBarClass w where
castToSimpleMenuBar :: w -> SimpleMenuBar
menuBarItemAdd :: SimpleMenuItemClass item => w -> item -> UIApp u ()
menuBarItemAdd (castToSimpleMenuBar -> menuBar) (castToSimpleMenuItem -> item) = do
getColors menuBar >>= setColors item
menuBar `connectColorsTo` item
addTo (_simpleMenuBarContainer menuBar) item def { fillLayoutHExpand = False }
add' menuBar _simpleMenuBarItems item
on_ item activated $ do
items <- get menuBar _simpleMenuBarItems
forM_ items $ \i ->
set i selected False
set item selected True
instance WidgetClass SimpleMenuBar where
castToWidget = _simpleMenuBarParent
overrideWidget = overrideWidgetHelper simpleMenuBarParent
instance SimpleMenuBarClass SimpleMenuBar where
castToSimpleMenuBar = id
simpleMenuBarNew :: UIApp u SimpleMenuBar
simpleMenuBarNew = do
_layout <- fillLayoutHorizontalNew
container <- containerNew _layout
itemList <- attributeNew []
let _simpleMenuBar = SimpleMenuBar
{ _simpleMenuBarParent = castToWidget container
, _simpleMenuBarContainer = container
, _simpleMenuBarItems = itemList
}
let simpleMenuBar = overrideWidget _simpleMenuBar $
virtualWidgetName .= "simplemenuitem"
set simpleMenuBar colorForeground Vty.black
set simpleMenuBar colorBackground Vty.green
set simpleMenuBar colorForegroundSelected Vty.green
set simpleMenuBar colorBackgroundSelected Vty.brightBlack
return simpleMenuBar