{- * 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 #-} {-# 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