{- * 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 -} {-# LANGUAGE OverloadedStrings #-} module Mp.UI.StatusBar ( StatusBar (..), StatusBarWidget, makeUIStatusBar ) where import qualified Data.Text as T import Graphics.Vty.Widgets.All import Data.ConfigFile import Data.Maybe import Control.Monad import Control.Concurrent import Mp.Utils.Colors import Mp.Utils.Utils import Mp.Utils.Exception import Mp.Player.Client import Mp.Utils.I18N type StatusBarWidget = Widget (Box (Box FormattedText HFill) FormattedText) data StatusBar = StatusBar { statusBarWidget :: StatusBarWidget, statusBarSetText :: String -> IO (), statusBarReset :: IO (), statusBarServerStatus :: IO String } makeUIStatusBar :: ConfigParser -> IO StatusBar makeUIStatusBar conf = do enabled <- newMVar True stat <- newMVar (__ "Stopped") left <- plainText "" >>= withStatusAttribute conf fill <- hFill ' ' 1 >>= withStatusAttribute conf right <- plainText "" >>= withStatusAttribute conf status <- return left <++> return fill <++> return right _ <- scheduleStatusFromServer enabled stat left right return StatusBar { statusBarWidget = status, statusBarSetText = statusSetText enabled left right, statusBarReset = statusReset enabled, statusBarServerStatus = readMVar stat } where statusSetText enabled left right text = do _ <- tryTakeMVar enabled setText left $ T.pack text setText right "" statusReset enabled = do putMVar enabled True scheduleStatusFromServer switch stat left right = forkIO $ forever $ do _ <- takeMVar switch putMVar switch True schedule $ do success <- try' $ clientSendGetStatus when (isJust success) $ do let (status, dur, pos) = fromJust success let dur' = timeToString dur let pos' = timeToString pos setText left $ T.pack (" " ++ (statusToString status) ++ " [" ++ pos' ++ "/" ++ dur' ++ "]") modifyMVar_ stat (const $ return status) flags <- clientSendGetFlags vol <- clientSendVolumeGet setText right $ (T.pack $ "[" ++ flags ++ "] " ++ (__ "Volume:") ++ " " ++ vol ++ " % ") threadDelay 200000 statusToString status = case status of "Stopped" -> __ "Stopped" "Playing" -> __ "Playing" "Paused" -> __ "Paused" _ -> __ "Unknown"