{- * 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.StatusBar ( StatusBar, castToStatusBar, statusBarNew, textLeft, textCenter, textRight ) where import Control.Lens (makeLensesFor, (.=)) import qualified Graphics.Vty as Vty import Simple.UI.Core.Internal.UIApp import Simple.UI.Core.Attribute import Simple.UI.Layouts.FillLayout import Simple.UI.Widgets.Container import Simple.UI.Widgets.Label import Simple.UI.Widgets.Text import Simple.UI.Widgets.Widget data StatusBar = StatusBar { _statusBarParent :: Widget , _statusBarTextLeft :: Label , _statusBarTextCenter :: Label , _statusBarTextRight :: Label } makeLensesFor [("_statusBarParent", "statusBarParent")] ''StatusBar class WidgetClass w => StatusBarClass w where castToStatusBar :: w -> StatusBar textLeft :: w -> Attribute (Maybe String) textLeft = text . _statusBarTextLeft . castToStatusBar textCenter :: w -> Attribute (Maybe String) textCenter = text . _statusBarTextCenter . castToStatusBar textRight :: w -> Attribute (Maybe String) textRight = text . _statusBarTextRight . castToStatusBar instance StatusBarClass StatusBar where castToStatusBar = id instance WidgetClass StatusBar where castToWidget = _statusBarParent overrideWidget = overrideWidgetHelper statusBarParent statusBarNew :: UIApp u StatusBar statusBarNew = do left <- labelNew Nothing set left align TextAlignLeft center <- labelNew Nothing set center align TextAlignCenter right <- labelNew Nothing set right align TextAlignRight _layout <- fillLayoutHorizontalNew container <- containerNew _layout addTo container left def addTo container center def addTo container right def let _statusBar = StatusBar { _statusBarParent = castToWidget container , _statusBarTextLeft = left , _statusBarTextCenter = center , _statusBarTextRight = right } let statusBar = overrideWidget _statusBar $ virtualWidgetName .= "statusbar" statusBar `connectColorsTo` left statusBar `connectColorsTo` center statusBar `connectColorsTo` right set statusBar colorForeground Vty.black set statusBar colorBackground Vty.green return statusBar