mp-0.1.3: src/Mp/Utils/Colors.hs
{-
* Programmer: Piotr Borek
* E-mail: piotrborek@op.pl
* Copyright 2014 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
-}
module Mp.Utils.Colors (
withTabAttribute,
withTabActiveAttribute,
withHelpAttribute,
helpAttribute,
withStatusAttribute,
withBrowserFileAttribute,
withBrowserDirectoryAttribute,
withBrowserBgAttribute,
browserActiveAttribute,
withBrowserSelectedAttribute,
withQueueBgAttribute,
withQueueFileAttribute,
queueActiveAttribute,
withQueueSelectedAttribute,
playlistActiveAttribute,
withPlaylistBgAttribute,
withPlaylistNameAttribute,
withPlaylistFileAttribute,
withPlaylistSelectedAttribute,
withEditAttribute
) where
import Graphics.Vty.Widgets.All
import Graphics.Vty.Attributes
import Data.ConfigFile
import Mp.Configuration.Configuration
setAttribute :: Widget w -> Attr -> IO (Widget w)
setAttribute w attr = do
setNormalAttribute w attr
setFocusAttribute w attr
return w
withTabAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withTabAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "tab_foreground"
(bg, _) = getConfigurationColor conf "tab_background"
attr = (fg `on` bg) `with_style` st
withTabActiveAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withTabActiveAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "tab_active_foreground"
(bg, _) = getConfigurationColor conf "tab_active_background"
attr = (fg `on` bg) `with_style` st
withHelpAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withHelpAttribute conf w = setAttribute w $ helpAttribute conf
helpAttribute :: ConfigParser -> Attr
helpAttribute conf = attr
where
(fg, st) = getConfigurationColor conf "help_foreground"
(bg, _) = getConfigurationColor conf "help_background"
attr = (fg `on` bg) `with_style` st
withStatusAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withStatusAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "status_foreground"
(bg, _) = getConfigurationColor conf "status_background"
attr = (fg `on` bg) `with_style` st
withBrowserFileAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withBrowserFileAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "browser_file_foreground"
(bg, _) = getConfigurationColor conf "browser_background"
attr = (fg `on` bg) `with_style` st
withBrowserDirectoryAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withBrowserDirectoryAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "browser_dir_foreground"
(bg, _) = getConfigurationColor conf "browser_background"
attr = (fg `on` bg) `with_style` st
withBrowserBgAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withBrowserBgAttribute conf w = setAttribute w attr
where
(bg, _) = getConfigurationColor conf "browser_background"
attr = bgColor bg
browserActiveAttribute :: ConfigParser -> Attr
browserActiveAttribute conf = attr
where
(bg, _) = getConfigurationColor conf "browser_active_background"
attr = bgColor bg
withBrowserSelectedAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withBrowserSelectedAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "browser_selected_foreground"
attr = fgColor fg `with_style` st
withQueueBgAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withQueueBgAttribute conf w = setAttribute w attr
where
(bg, _) = getConfigurationColor conf "queue_background"
attr = bgColor bg
withQueueFileAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withQueueFileAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "queue_foreground"
(bg, _) = getConfigurationColor conf "queue_background"
attr = (fg `on` bg) `with_style` st
queueActiveAttribute :: ConfigParser -> Attr
queueActiveAttribute conf = attr
where
(bg, _) = getConfigurationColor conf "queue_active_background"
attr = bgColor bg
withQueueSelectedAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withQueueSelectedAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "queue_selected_foreground"
attr = fgColor fg `with_style` st
playlistActiveAttribute :: ConfigParser -> Attr
playlistActiveAttribute conf = attr
where
(bg, _) = getConfigurationColor conf "playlist_active_background"
attr = bgColor bg
withPlaylistBgAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withPlaylistBgAttribute conf w = setAttribute w attr
where
(bg, _) = getConfigurationColor conf "playlist_background"
attr = bgColor bg
withPlaylistNameAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withPlaylistNameAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "playlist_foreground"
(bg, _) = getConfigurationColor conf "playlist_background"
attr = (fg `on` bg) `with_style` st
withPlaylistFileAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withPlaylistFileAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "playlist_file_foreground"
(bg, _) = getConfigurationColor conf "playlist_background"
attr = (fg `on` bg) `with_style` st
withPlaylistSelectedAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withPlaylistSelectedAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "playlist_selected_foreground"
attr = fgColor fg `with_style` st
withEditAttribute :: ConfigParser -> Widget w -> IO (Widget w)
withEditAttribute conf w = setAttribute w attr
where
(fg, st) = getConfigurationColor conf "edit_foreground"
(bg, _) = getConfigurationColor conf "edit_background"
attr = (fg `on` bg) `with_style` st