packages feed

mp (empty) → 0.1.3

raw patch · 30 files changed

+3435/−0 lines, 30 filesdep +ConfigFiledep +MissingHdep +basesetup-changedbinary-added

Dependencies added: ConfigFile, MissingH, base, binary, bytestring, daemons, directory, filepath, glib, gstreamer, hgettext, mtl, network, random, setlocale, text, unix, unordered-containers, utf8-string, vty, vty-ui

Files

+ LICENSE view
@@ -0,0 +1,1 @@+GPL
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ gen_gettext view
@@ -0,0 +1,27 @@+#!/bin/bash++hgettext -k __ -o i18n/messages.pot \+    src/Mp/UI/PlaylistPage.hs \+    src/Mp/UI/PlaylistPage.hs \+    src/Mp/UI/Menu.hs \+    src/Mp/UI/QueuePage.hs \+    src/Mp/UI/Main.hs \+    src/Mp/UI/StatusBar.hs \+    src/Mp/UI/PlaylistState.hs \+    src/Mp/UI/BrowserPage.hs \+    src/Mp/UI/HelpPage.hs \+    src/Mp/UI/EditBar.hs \+    src/Mp/Main.hs \+    src/Mp/Player/GstPlayer.hs \+    src/Mp/Player/ServerState.hs \+    src/Mp/Player/Daemon.hs \+    src/Mp/Player/Server.hs \+    src/Mp/Player/Client.hs \+    src/Mp/Configuration/ConfigurationFile.hs \+    src/Mp/Configuration/Configuration.hs \+    src/Mp/Utils/Utils.hs \+    src/Mp/Utils/Exception.hs \+    src/Mp/Utils/I18N.hs \+    src/Mp/Utils/Colors.hs \+    src/Mp/Utils/Network.hs \+    src/Mp/Utils/Shuffle.hs
+ i18n/messages.pot view
@@ -0,0 +1,183 @@+# Translation file++msgid ""+msgstr ""++"Project-Id-Version: PACKAGE VERSION\n"+"Report-Msgid-Bugs-To: \n"+"POT-Creation-Date: 2009-01-13 06:05-0800\n"+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"+"Language-Team: LANGUAGE <LL@li.org>\n"+"MIME-Version: 1.0\n"+"Content-Type: text/plain; charset=UTF-8\n"+"Content-Transfer-Encoding: 8bit\n"++#: src/Mp/UI/Menu.hs:0+msgid " [1]   Help     "+msgstr ""++#: src/Mp/UI/Menu.hs:0+msgid " [2]  Queue     "+msgstr ""++#: src/Mp/UI/Menu.hs:0+msgid " [3] Playlists  "+msgstr ""++#: src/Mp/UI/Menu.hs:0+msgid " [4]  Browser   "+msgstr ""++#: src/Mp/UI/Main.hs:0+msgid "File exists. Overwrite (Y/N) ?"+msgstr ""++#: src/Mp/UI/Main.hs:0+msgid "Enter playlist name:"+msgstr ""++#: src/Mp/UI/StatusBar.hs:0+msgid "Stopped"+msgstr ""++#: src/Mp/UI/StatusBar.hs:0+msgid "Volume:"+msgstr ""++#: src/Mp/UI/StatusBar.hs:0+msgid "Playing"+msgstr ""++#: src/Mp/UI/StatusBar.hs:0+msgid "Paused"+msgstr ""++#: src/Mp/UI/StatusBar.hs:0+msgid "Unknown"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Detach from the server"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Quit"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Help screen"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Queue screen"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Playlists screen"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Browser screen"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Next screen"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Previous screen"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Move cursor up"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Move cursor down"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Page up"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Page down"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Start playing / Enter directory / Enter playlist"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Stop playing"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Pause / resume playing"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Add file / directory / playlist"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Remove file / directory / playlist"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Clear the queue"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Center"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Save playlist"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Delete playlist"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Go to root directory"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Go to parent directory"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Play next file"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Play previous file"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Seek forward"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Seek backward"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Toggle repeat mode"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Toggle random mode"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Decrease volume"+msgstr ""++#: src/Mp/UI/HelpPage.hs:0+msgid "Increase volume"+msgstr ""+
+ i18n/pl.po view
@@ -0,0 +1,182 @@+# Translation file+msgid ""+msgstr ""+"Project-Id-Version: workspace 4\n"+"Report-Msgid-Bugs-To: \n"+"POT-Creation-Date: 2009-01-13 06:05-0800\n"+"PO-Revision-Date: 2014-09-25 18:28+0000\n"+"Last-Translator: piotr <piotrborek@op.pl>\n"+"Language-Team: Polish\n"+"Language: pl\n"+"MIME-Version: 1.0\n"+"Content-Type: text/plain; charset=UTF-8\n"+"Content-Transfer-Encoding: 8bit\n"+"Plural-Forms: nplurals=2; plural=(n != 1);\n"++#: src/Mp/UI/Menu.hs:0+msgid " [1]   Help     "+msgstr " [1]   Pomoc    "++#: src/Mp/UI/Menu.hs:0+msgid " [2]  Queue     "+msgstr " [2]  Lista     "++#: src/Mp/UI/Menu.hs:0+msgid " [3] Playlists  "+msgstr " [3] Playlisty  "++#: src/Mp/UI/Menu.hs:0+msgid " [4]  Browser   "+msgstr " [4] Przeglądaj "++#: src/Mp/UI/Main.hs:0+msgid "File exists. Overwrite (Y/N) ?"+msgstr "Plik istnieje. Nadpisać (Y/N) ?"++#: src/Mp/UI/Main.hs:0+msgid "Enter playlist name:"+msgstr "Wpisza nazwę dla playlisty:"++#: src/Mp/UI/StatusBar.hs:0+msgid "Stopped"+msgstr "Zatrzymane"++#: src/Mp/UI/StatusBar.hs:0+msgid "Volume:"+msgstr "Głośność:"++#: src/Mp/UI/StatusBar.hs:0+msgid "Playing"+msgstr "Odtwarzanie"++#: src/Mp/UI/StatusBar.hs:0+msgid "Paused"+msgstr "Wstrzymane"++#: src/Mp/UI/StatusBar.hs:0+msgid "Unknown"+msgstr "Unknown"++#: src/Mp/UI/HelpPage.hs:0+msgid "Detach from the server"+msgstr "Wyjdź i odtwarzaj muzykę w tle"++#: src/Mp/UI/HelpPage.hs:0+msgid "Quit"+msgstr "Wyjdź"++#: src/Mp/UI/HelpPage.hs:0+msgid "Help screen"+msgstr "Ekran pomocy"++#: src/Mp/UI/HelpPage.hs:0+msgid "Queue screen"+msgstr "Ekran listy odwarzania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Playlists screen"+msgstr "Ekran playlist"++#: src/Mp/UI/HelpPage.hs:0+msgid "Browser screen"+msgstr "Ekran przeglądania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Next screen"+msgstr "Następny ekran"++#: src/Mp/UI/HelpPage.hs:0+msgid "Previous screen"+msgstr "Poprzedni ekran"++#: src/Mp/UI/HelpPage.hs:0+msgid "Move cursor up"+msgstr "Przesuń kursor w górę"++#: src/Mp/UI/HelpPage.hs:0+msgid "Move cursor down"+msgstr "Przesuń kursor w dół"++#: src/Mp/UI/HelpPage.hs:0+msgid "Page up"+msgstr "Przesuń o stronę do góry"++#: src/Mp/UI/HelpPage.hs:0+msgid "Page down"+msgstr "Przesuń o stronę w dół"++#: src/Mp/UI/HelpPage.hs:0+msgid "Start playing / Enter directory / Enter playlist"+msgstr "Odwarzaj / Otwórz katalog / Wejdź do playlisty"++#: src/Mp/UI/HelpPage.hs:0+msgid "Stop playing"+msgstr "Zatrzymaj odtwarzanie"++#: src/Mp/UI/HelpPage.hs:0+msgid "Pause / resume playing"+msgstr "Wstrzymaj odtwarzanie"++#: src/Mp/UI/HelpPage.hs:0+msgid "Add file / directory / playlist"+msgstr "Dodaj plik / katalog / playlistę do listy odtwarzania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Remove file / directory / playlist"+msgstr "Usuń plik / katalog / playlistę z listy odtwarzania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Clear the queue"+msgstr "Wyczyść listę odtwarzania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Center"+msgstr "Wyśrodkuj"++#: src/Mp/UI/HelpPage.hs:0+msgid "Save playlist"+msgstr "Zapisz listę odtwarzania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Delete playlist"+msgstr "Usuń listę odtwarzania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Go to root directory"+msgstr "Przejdź do katalogu głównego"++#: src/Mp/UI/HelpPage.hs:0+msgid "Go to parent directory"+msgstr "przejdź do katalogu nadrzędnego"++#: src/Mp/UI/HelpPage.hs:0+msgid "Play next file"+msgstr "Następna ścieżka"++#: src/Mp/UI/HelpPage.hs:0+msgid "Play previous file"+msgstr "Poprzednia ścieżka"++#: src/Mp/UI/HelpPage.hs:0+msgid "Seek forward"+msgstr "Przewiń naprzód"++#: src/Mp/UI/HelpPage.hs:0+msgid "Seek backward"+msgstr "Przewiń wstecz"++#: src/Mp/UI/HelpPage.hs:0+msgid "Toggle repeat mode"+msgstr "Przełącz tryb powtarzania"++#: src/Mp/UI/HelpPage.hs:0+msgid "Toggle random mode"+msgstr "Przełącz tryb losowy"++#: src/Mp/UI/HelpPage.hs:0+msgid "Decrease volume"+msgstr "Przycisz"++#: src/Mp/UI/HelpPage.hs:0+msgid "Increase volume"+msgstr "Zgłośnij"
+ i18n/pl/LC_MESSAGES/mp.mo view

binary file changed (absent → 2941 bytes)

+ mp.cabal view
@@ -0,0 +1,56 @@+name:               mp+version:            0.1.3+cabal-version:      >=1.16+build-type:         Simple+author:             Piotr Borek <piotrborek@op.pl>+maintainer:         Piotr Borek <piotrborek@op.pl>+license:            GPL+license-file:       LICENSE+synopsis:           Music player for linux.+description:        Music player for linux.+category:           Sound++data-files:+  gen_gettext+  i18n/messages.pot+  i18n/pl.po+  i18n/pl/LC_MESSAGES/mp.mo++executable mp+  hs-source-dirs:   src+  main-is:          Mp/Main.hs+  build-depends:    base (>= 4 && < 5), vty-ui == 1.7.1, vty < 5, text,+                    directory (>= 1.2 && < 1.3), ConfigFile (>= 1.1 && < 1.2),+                    MissingH (>= 1.2 && < 1.3), filepath (>= 1.3 && < 1.4),+                    daemons (>= 0.2 && < 0.3), bytestring, network (>= 2.6 && < 2.7),+                    gstreamer (>= 0.12.5.0 && < 0.13), glib (>= 0.12.5.0 && < 0.13),+                    unordered-containers (>= 0.2 && < 0.3), binary (>= 0.7 && < 0.8),+                    hgettext (>= 0.1 && < 0.2), setlocale, unix, random, utf8-string,+                    mtl+  default-language: Haskell2010+  ghc-options:      -Wall -O2 -threaded++  other-modules:+    Mp.UI.PlaylistPage+    Mp.UI.Menu+    Mp.UI.QueuePage+    Mp.UI.Main+    Mp.UI.StatusBar+    Mp.UI.PlaylistState+    Mp.UI.BrowserPage+    Mp.UI.HelpPage+    Mp.UI.EditBar+    Mp.Player.GstPlayer+    Mp.Player.ServerState+    Mp.Player.Daemon+    Mp.Player.Server+    Mp.Player.Client+    Mp.Configuration.ConfigurationFile+    Mp.Configuration.Configuration+    Mp.Utils.Utils+    Mp.Utils.Exception+    Mp.Utils.I18N+    Mp.Utils.Shuffle+    Mp.Utils.Colors+    Mp.Utils.Network+
+ src/Mp/Configuration/Configuration.hs view
@@ -0,0 +1,91 @@+{-  + *  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.Configuration.Configuration (+    configDirFilePath,+    playlistDirFilePath,+    readConfiguration,+    getConfiguration,+    getMusicDirectory,+    getConfigurationColor,+    makeDefaultConfiguration+) where++import Control.Monad+import System.Environment+import System.Directory+import Data.Either.Utils+import Data.ConfigFile hiding (content)+import Graphics.Vty+import System.FilePath.Posix++import Mp.Utils.Utils+import Mp.Configuration.ConfigurationFile++configDir :: String+configDir  = ".config/mp"++configFile :: String+configFile = "mp.config"++configDirFilePath :: IO FilePath+configDirFilePath = do+    homeDir <- getEnv "HOME"+    return $ homeDir </> configDir++playlistDirFilePath :: IO FilePath+playlistDirFilePath = do+    cfg <- configDirFilePath+    return $ cfg </> "playlists"++readConfiguration :: IO ConfigParser+readConfiguration = do+    confDir <- configDirFilePath+    let file = confDir </> configFile+    conf <- readfile emptyCP file+    return $ forceEither conf++getConfiguration :: ConfigParser -> SectionSpec -> OptionSpec -> String+getConfiguration parser section option =+    forceEither $ get parser section option++getMusicDirectory :: ConfigParser -> String+getMusicDirectory conf = getConfiguration conf "general" "music_dir"++getConfigurationColor :: ConfigParser -> OptionSpec -> (Color, Style)+getConfigurationColor parser option  = toVtyColor $ getConfiguration parser "colors" option++makeDefaultConfiguration :: IO ()+makeDefaultConfiguration = do+    confDir <- configDirFilePath+    playlistDir <- playlistDirFilePath+    createDirectoryIfMissing True confDir+    createDirectoryIfMissing True playlistDir+    makeDefaultConfigurationFile confDir++makeDefaultConfigurationFile :: String -> IO ()+makeDefaultConfigurationFile confDir = do+    homeDir <- getEnv "HOME"+    exist <- doesFileExist file+    unless exist $ writeFile file $ defaultConfiguration homeDir+    where+        file = confDir </> configFile
+ src/Mp/Configuration/ConfigurationFile.hs view
@@ -0,0 +1,81 @@+{-  + *  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.Configuration.ConfigurationFile where++defaultConfiguration :: String -> String+defaultConfiguration home_dir =+    "# mp configuration file\n" +++    "\n" +++    "[general]\n" +++    "music_dir = " ++ home_dir ++ "\n\n" +++    "[colors]\n" +++    "# Valid colors :\n" +++    "#   black\n" +++    "#   white\n" +++    "#   cyan\n" +++    "#   magenta\n" +++    "#   blue\n" +++    "#   yellow\n" +++    "#   green\n" +++    "#   red\n" +++    "#\n" +++    "#   Additional colors for foreground:\n" +++    "#\n" +++    "#   brightBlack\n" +++    "#   brightYellow\n" +++    "#   brightGreen\n" +++    "#   brightRed\n" +++    "#   brightBlue\n" +++    "#   brightWhite\n" +++    "#   brightCyan\n" +++    "#   brightMagenta\n" +++    "tab_foreground               = black\n" +++    "tab_background               = green\n" +++    "tab_active_foreground        = brightWhite\n" +++    "tab_active_background        = blue\n" +++    "\n" +++    "status_foreground            = brightWhite\n" +++    "status_background            = blue\n" +++    "\n" +++    "help_foreground              = white\n" +++    "help_background              = black\n" +++    "\n" +++    "browser_background           = black\n" +++    "browser_dir_foreground       = brightWhite\n" +++    "browser_file_foreground      = white\n" +++    "browser_active_background    = yellow\n" +++    "browser_selected_foreground  = brightCyan\n" +++    "\n" +++    "queue_foreground             = white\n" +++    "queue_background             = black\n" +++    "queue_active_background      = yellow\n" +++    "queue_selected_foreground    = brightCyan\n" +++    "\n" +++    "playlist_background          = black\n" +++    "playlist_foreground          = brightWhite\n" +++    "playlist_file_foreground     = white\n" +++    "playlist_selected_foreground = brightCyan\n" +++    "playlist_active_background   = yellow\n" +++    "\n" +++    "edit_background              = black\n" +++    "edit_foreground              = brightWhite\n"
+ src/Mp/Main.hs view
@@ -0,0 +1,59 @@+{-  + *  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 Main where++import Text.I18N.GetText+import System.Locale.SetLocale+import System.Directory+import System.Environment+import System.FilePath.Posix++import Mp.Configuration.Configuration+import Mp.Player.Daemon+import Mp.UI.Main+import Mp.Utils.Utils++main :: IO ()+main = do+    args <- getArgs+    exePath <- findExecutable "mp"+    dir <- getCurrentDirectory++    _ <- setLocale LC_ALL (Just "")++    _ <- case exePath of+             Just path -> do+                let (exeDir, _) = separateFilePath path+                bindTextDomain "mp" (Just $ exeDir </> "i18n")+             Nothing   ->+                bindTextDomain "mp" (Just $ dir </> "i18n")++    _ <- textDomain (Just "mp")++    makeDefaultConfiguration+    runPlayerDaemon++    if any ("--daemon" == ) args then+        return ()+    else+        makeAndRunUI
+ src/Mp/Player/Client.hs view
@@ -0,0 +1,164 @@+{-  + *  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.Player.Client (+    clientSendQuitMessage,+    clientSendAddFile,+    clientSendRemove,+    clientSendClear,+    clientSendGetPlaylist,+    clientSendGetStatus,+    clientSendSetPlaying,+    clientSendGetPlaying,+    clientSendStopPlaying,+    clientSendPausePlaying,+    clientSendResumePlaying,+    clientSendPlayNext,+    clientSendPlayPrev,+    clientSendVolumeUp,+    clientSendVolumeDown,+    clientSendVolumeGet,+    clientSendSeekForward,+    clientSendSeekBackward,+    clientSendGetFlags,+    clientSendToggleRepeat,+    clientSendToggleShuffle+) where++import System.FilePath.Posix+import Network.Socket hiding (send, sendTo, recv, recvFrom)++import Mp.Configuration.Configuration+import Mp.Utils.Network++withConnection :: (Socket -> IO a) -> IO a+withConnection action = do+    confPath <- configDirFilePath+    let socName = confPath </> "mp.socket"++    sock <- socket AF_UNIX Stream defaultProtocol+    connect sock $ SockAddrUnix socName++    value <- action sock++    close sock+    return value++sendMessage :: String -> Socket -> IO String+sendMessage msg sock = do+    sendString sock msg     -- send message+    rval <- recvString sock -- receive answer+    return rval++sendMessage_ :: String -> Socket -> IO ()+sendMessage_ msg sock = sendMessage msg sock >> return ()++clientSendQuitMessage :: IO ()+clientSendQuitMessage = withConnection $ sendMessage_ "Quit"++clientSendAddFile :: String -> IO ()+clientSendAddFile file = do+    withConnection $ \conn -> do+        sendMessage_ "Add" conn+        sendMessage_ file conn++clientSendRemove :: Int -> IO ()+clientSendRemove index = do+    withConnection $ \conn -> do+        sendMessage_ "Remove" conn+        sendMessage_ (show index) conn++clientSendClear :: IO ()+clientSendClear = withConnection $ sendMessage_ "Clear"++clientSendGetPlaylist :: IO [String]+clientSendGetPlaylist = do+    withConnection $ \conn -> do+        item <- sendMessage "GetPlaylist" conn+        if item == "EndPlaylist"+            then return []+            else processMessages [item] conn+    where+        processMessages xs conn = do+            item <- sendMessage "Get" conn+            if (item == "EndPlaylist")+                then return xs+                else processMessages (item : xs) conn++clientSendGetStatus :: IO (String, Integer, Integer)+clientSendGetStatus = do+    withConnection $ \conn -> do+        status <- sendMessage "GetStatus" conn+        dur    <- sendMessage "GetDuration" conn+        pos    <- sendMessage "GetPosition" conn+        return (status, (read dur :: Integer), (read pos :: Integer))++clientSendSetPlaying :: Int -> IO ()+clientSendSetPlaying index = do+    withConnection $ \conn -> do+        sendMessage_ "SetPlay" conn+        sendMessage_ (show index) conn++clientSendGetPlaying :: IO Int+clientSendGetPlaying = do+    withConnection $ \conn -> do+        index <- sendMessage "GetPlay" conn+        return (read index :: Int)++clientSendStopPlaying :: IO ()+clientSendStopPlaying = withConnection $ sendMessage_ "Stop"++clientSendPausePlaying :: IO ()+clientSendPausePlaying = withConnection $ sendMessage_ "Pause"++clientSendResumePlaying :: IO ()+clientSendResumePlaying = withConnection $ sendMessage_ "Resume"++clientSendPlayNext :: IO ()+clientSendPlayNext = withConnection $ sendMessage_ "Next"++clientSendPlayPrev :: IO ()+clientSendPlayPrev = withConnection $ sendMessage_ "Prev"++clientSendVolumeUp :: IO ()+clientSendVolumeUp = withConnection $ sendMessage_ "VolUp"++clientSendVolumeDown :: IO ()+clientSendVolumeDown = withConnection $ sendMessage_ "VolDown"++clientSendVolumeGet :: IO String+clientSendVolumeGet = withConnection $ sendMessage "VolGet"++clientSendSeekForward :: IO ()+clientSendSeekForward = withConnection $ sendMessage_ "SeekForward"++clientSendSeekBackward :: IO ()+clientSendSeekBackward = withConnection $ sendMessage_ "SeekBackward"++clientSendGetFlags :: IO String+clientSendGetFlags = withConnection $ sendMessage "GetFlags"++clientSendToggleRepeat :: IO ()+clientSendToggleRepeat = withConnection $ sendMessage_ "ToggleRepeat"++clientSendToggleShuffle :: IO ()+clientSendToggleShuffle = withConnection $ sendMessage_ "ToggleShuffle"
+ src/Mp/Player/Daemon.hs view
@@ -0,0 +1,47 @@+{-  + *  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.Player.Daemon (+    runPlayerDaemon+) where++import System.Directory+import System.Posix.Daemon+import System.FilePath.Posix++import Mp.Configuration.Configuration+import Mp.Player.Server+import Mp.Utils.Exception++runPlayerDaemon :: IO ()+runPlayerDaemon = do+    confDir <- configDirFilePath+    let pidFile    = confDir </> "pid"+    let output_log = confDir </> "daemon_log"+    let socName = confDir </> "mp.socket"++    alreadyRunning <- isRunning pidFile+    if alreadyRunning+        then return ()+        else do+            _ <- try' $ removeFile socName+            runDetached (Just pidFile) (ToFile output_log) (startServerBlocking socName)
+ src/Mp/Player/GstPlayer.hs view
@@ -0,0 +1,167 @@+{-  + *  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.Player.GstPlayer (+    GstPlayer(),+    initGstPlayer,+    gstPlayerMainLoopBlocking,+    gstPlayerQuit,+    gstPlayerPlay,+    gstPlayerPause,+    gstPlayerStop,+    gstPlayerResume,+    gstPlayerSetVolume,+    gstPlayerGetTimeInfo,+    gstPlayerTimeoutAdd,+    gstPlayerAddIdle,+    gstBusAddWatch,+    gstPlayerSeek+) where++import System.Exit+import Control.Monad+import Data.Maybe+import Data.String.Utils++import qualified Media.Streaming.GStreamer as Gst+import qualified Media.Streaming.GStreamer.Core.Types as Gst+import qualified System.Glib.MainLoop as G+import qualified System.Glib.Properties as G+import qualified System.Glib.Signals as G++data GstPlayer = GstPlayer {+    gstPlayerSource   :: Gst.Element,+    gstPlayerVolume   :: Gst.Element,+    gstPlayerPipeline :: Gst.Element,+    gstPlayerMainLoop :: G.MainLoop+}++makeElement :: String -> String -> IO Gst.Element+makeElement factoryName name = do+    element <- Gst.elementFactoryMake factoryName $ Just name+    case element of+        Just e  -> return e+        Nothing -> do+            putStrLn $ "Could not create GStreamer \"" ++ factoryName ++ "\"element."+            exitFailure++initGstPlayer :: IO GstPlayer+initGstPlayer = do+    Gst.init++    mainLoop <- G.mainLoopNew Nothing True++    source   <- makeElement "uridecodebin"  "File source"+    convert  <- makeElement "audioconvert"  "Audio converter"+    volume   <- makeElement "volume"        "Audio volume"+    sink     <- makeElement "autoaudiosink" "Auto audio sink"++    pipeline <- Gst.pipelineNew "pipeline"++    mapM_ (Gst.binAdd $ Gst.castToBin pipeline) [source, convert, volume, sink]+    _ <- Gst.elementLink convert volume+    _ <- Gst.elementLink volume sink++    _ <- G.on source Gst.elementPadAdded $ padAddedHandler convert++    return $ GstPlayer source volume pipeline mainLoop++padAddedHandler :: Gst.Element -> Gst.Pad -> IO ()+padAddedHandler convert pad = do+    maybeSinkPad <- Gst.elementGetStaticPad convert "sink"+    let sinkPad = fromJust maybeSinkPad+    sinkPadIsLinked <- Gst.padIsLinked sinkPad++    unless sinkPadIsLinked $ do+        padCaps <- Gst.padGetCaps pad+        let capsStruct = fromJust $ Gst.capsGetStructure padCaps 0+        let structName = Gst.structureName capsStruct+        when (startswith "audio/x-raw" structName) $ Gst.padLink pad sinkPad >> return ()++gstPlayerGetTimeInfo :: GstPlayer -> IO (Maybe (Integer, Integer))+gstPlayerGetTimeInfo player = do+    position <- Gst.elementQueryPosition (gstPlayerPipeline player) Gst.FormatTime+    duration <- Gst.elementQueryDuration (gstPlayerPipeline player) Gst.FormatTime+    if (and [isJust position, isJust duration])+        then do+            let (_, position') = fromJust position+            let (_, duration') = fromJust duration+            return $ Just (fromIntegral (position' `div` Gst.second) :: Integer, fromIntegral (duration' `div` Gst.second) :: Integer)+        else+            return Nothing++gstPlayerTimeoutAdd :: Int -> IO Bool -> IO ()+gstPlayerTimeoutAdd time action = flip G.timeoutAdd time action >> return ()++gstBusAddWatch ::  GstPlayer -> Gst.BusFunc -> IO ()+gstBusAddWatch player action = do+    bus <- Gst.pipelineGetBus (Gst.castToPipeline $ gstPlayerPipeline player)+    _ <- Gst.busAddWatch bus G.priorityDefault action+    return ()++gstPlayerMainLoopBlocking :: GstPlayer -> IO ()+gstPlayerMainLoopBlocking player = G.mainLoopRun $ gstPlayerMainLoop player++-- Functions below can be called from any thread+gstPlayerAddIdle :: IO Bool -> IO ()+gstPlayerAddIdle callback = G.idleAdd callback G.priorityDefaultIdle >> return ()++gstPlayerQuit :: GstPlayer -> IO ()+gstPlayerQuit player = gstPlayerAddIdle $ do+    G.mainLoopQuit $ gstPlayerMainLoop player+    return False++gstPlayerPlay :: GstPlayer -> FilePath -> IO ()+gstPlayerPlay player file = gstPlayerAddIdle $ do+    let pipeline = gstPlayerPipeline player+    let source   = gstPlayerSource player+    _ <- Gst.elementSetState pipeline Gst.StateNull+    G.objectSetPropertyString "uri" source $ "file://" ++ file+    G.objectSetPropertyInt "buffer-size" source (4 * 1024 * 1024)+    _ <- Gst.elementSetState pipeline Gst.StatePlaying+    return False++gstPlayerPause :: GstPlayer -> IO ()+gstPlayerPause player = gstPlayerAddIdle $ do+    _ <- Gst.elementSetState (gstPlayerPipeline player) Gst.StatePaused+    return False++gstPlayerStop :: GstPlayer -> IO ()+gstPlayerStop player = gstPlayerAddIdle $ do+    _ <- Gst.elementSetState (gstPlayerPipeline player) Gst.StateNull+    return False++gstPlayerResume :: GstPlayer -> IO ()+gstPlayerResume player = gstPlayerAddIdle $ do+    _ <- Gst.elementSetState (gstPlayerPipeline player) Gst.StatePlaying+    return False++gstPlayerSetVolume :: GstPlayer -> Double -> IO ()+gstPlayerSetVolume player vol = gstPlayerAddIdle $ do+    let volume   = gstPlayerVolume player+    G.objectSetPropertyDouble "volume" volume vol+    return False++gstPlayerSeek :: GstPlayer -> Integer -> IO ()+gstPlayerSeek player pos = gstPlayerAddIdle $ do+    _ <- Gst.elementSeekSimple (gstPlayerPipeline player) Gst.FormatTime [Gst.SeekFlagFlush] $ fromIntegral $ (fromIntegral pos) * Gst.second+    return False
+ src/Mp/Player/Server.hs view
@@ -0,0 +1,450 @@+{-  + *  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.Player.Server (+    startServerBlocking+) where++import qualified Media.Streaming.GStreamer as Gst+import qualified Control.Monad.State as State++import Network.Socket+import System.FilePath.Posix+import System.Posix.Signals+import System.Random+import Control.Monad+import Control.Concurrent+import System.Directory+import Data.Binary+import Data.Maybe++import Mp.Configuration.Configuration+import Mp.Player.GstPlayer+import Mp.Utils.Utils+import Mp.Utils.Shuffle+import Mp.Utils.Exception+import Mp.Utils.Network+import Mp.Player.ServerState++makeServerSocket :: String -> IO Socket+makeServerSocket socName = do+    sock <- socket AF_UNIX Stream defaultProtocol+    bind sock $ SockAddrUnix socName+    listen sock 1+    return sock++saveServerState :: MVar ServerState -> IO ()+saveServerState serverState = do+    cfgDir <- configDirFilePath+    state <- readMVar serverState+    encodeFile (cfgDir </> "server.state") state++startServerBlocking :: String -> IO ()+startServerBlocking socName = do+    player <- initGstPlayer++    serverState <- newMVar defaultServerState++    readServerState player serverState+    schedulePlayerInfo player serverState++    _ <- forkIO $ do+        sock <- makeServerSocket socName++        _ <- installHandler sigINT  (Catch $ close sock) Nothing+        _ <- installHandler sigTERM (Catch $ close sock) Nothing++        talkBlocking serverState player sock++        close sock+        _ <- try' $ removeFile socName+        return ()++    gstBusAddWatch player $ \_ message -> do+        case Gst.messageType message of+            Gst.MessageEOS -> playerPlay serverState player succ+            _              -> return ()+        return True++    gstPlayerMainLoopBlocking player++    where+        readServerState player serverState = do+            cfgDir <- configDirFilePath+            let file = cfgDir </> "server.state"+            exists <- doesFileExist file+            when exists $ do+                modifyMVar_ serverState $ \_ -> do+                    state <- readStateFromFile file :: IO ServerState+                    gstPlayerSetVolume player $ getVolume state+                    when (getStatus state == "Playing") $ do+                        let f = getPlaylist state !! (shuffleFunc state) (getPlaying state)+                        gstPlayerPlay player f+                    return state++        schedulePlayerInfo player serverState =+            gstPlayerTimeoutAdd 100 $ do+                maybeInfo <- gstPlayerGetTimeInfo player+                if (isJust maybeInfo) then do+                    let (pos, dur) = fromJust maybeInfo+                    modifyMVar_ serverState $ \st -> do+                        return st {+                            getCurrentPosition = pos,+                            getCurrentDuration = dur+                        }+                else+                    modifyMVar_ serverState $ \st -> do+                        return st {+                            getCurrentPosition = 0,+                            getCurrentDuration = 0+                        }+                return True++playerPlay :: MVar ServerState -> GstPlayer -> (Int -> Int) -> IO ()+playerPlay serverState player indexFunction = do+    _ <- forkIO $ do+        threadDelay 400000+        st <- readMVar serverState+        when (and [getCurrentDuration st == 0, getStatus st == "Playing"]) $ playerPlay serverState player succ++    modifyMVar_ serverState $ \st -> do+        let list = getPlaylist st+        let index = indexFunction $ getPlaying st++        if and [index >= 0, index < length list]+            then+                modifyPlayerPlay st player index+            else+                if isRepeatMode st then do+                    let newIndex = if index < 0 then+                                       pred $ length list+                                   else if index >= length list then+                                       0+                                   else+                                       index+                    modifyPlayerPlay st player newIndex+                else+                    modifyPlayerStop st player++modifyPlayerStop :: ServerState -> GstPlayer -> IO ServerState+modifyPlayerStop st player = do+    gstPlayerStop player+    return st {+        getCurrentPosition = 0,+        getCurrentDuration = 0,+        getPlaying = -1,+        getStatus = "Stopped"+    }++modifyPlayerPlay :: ServerState -> GstPlayer -> Int -> IO ServerState+modifyPlayerPlay st player index = do+    let list = getPlaylist st+    let (f, d) = if isShuffleMode st then+                     State.runState shuffleFunction $ shuffleData st+                 else+                    (id, shuffleData st)+    gstPlayerPlay player $ list !! (f index)+    return st {+        getPlaying = index,+        getStatus = "Playing",+        shuffleFunc = f,+        shuffleData = d+    }++talkBlocking :: MVar ServerState -> GstPlayer -> Socket -> IO ()+talkBlocking serverState player sock = do+    _ <- try' processMessages+    saveServerState serverState+    gstPlayerStop player+    gstPlayerQuit player++    where+        processMessages = do+            (conn, _) <- accept sock+            msg <- recv conn 4096++            case msg of+                "Add"            -> talkAdd serverState conn+                "Remove"         -> talkRemove serverState player conn+                "Clear"          -> talkClear serverState player conn+                "GetPlaylist"    -> talkGetPlaylist serverState conn+                "GetStatus"      -> talkGetStatus serverState conn+                "SetPlay"        -> talkSetPlay serverState conn player+                "GetPlay"        -> talkGetPlay serverState conn+                "Stop"           -> talkStop serverState conn player+                "Pause"          -> talkPause serverState conn player+                "Resume"         -> talkResume serverState conn player+                "Next"           -> talkNext serverState conn player+                "Prev"           -> talkPrev serverState conn player+                "SeekForward"    -> talkSeekForward serverState conn player+                "SeekBackward"   -> talkSeekBackward serverState conn player+                "VolUp"          -> talkVolumeUp serverState conn player+                "VolDown"        -> talkVolumeDown serverState conn player+                "VolGet"         -> talkVolumeGet serverState conn+                "GetFlags"       -> talkGetFlags serverState conn+                "ToggleRepeat"   -> talkToggleRepeat serverState conn+                "ToggleShuffle"  -> talkToggleShuffle serverState player conn+                "Quit"           -> sendString conn "OK"+                _                -> sendString conn "NOK"++            close conn++            when (msg /= "Quit") processMessages++talkGetPlaylist :: MVar ServerState -> Socket -> IO ()+talkGetPlaylist serverState conn = do+    list <- readMVar serverState+    forM_ (reverse $ getPlaylist list) $ \item -> do+        sendString conn item+        recvString_ conn+        return ()++    sendString conn "EndPlaylist"++talkGetStatus :: MVar ServerState -> Socket -> IO ()+talkGetStatus serverState conn = do+    st <- readMVar serverState++    let status = getStatus st+    sendString conn status++    recvString_ conn+    let dur = getCurrentDuration st+    sendString conn $ show dur++    recvString_ conn+    let pos = getCurrentPosition st+    sendString conn  $ show pos++talkSetPlay :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkSetPlay serverState conn player = do+    sendString conn "OK"+    index <- recvString conn+    sendString conn "OK"++    st <- readMVar serverState+    if isShuffleMode st+        then+            playerPlay serverState player $ const 0+        else+            playerPlay serverState player $ const (read index :: Int)++talkGetPlay :: MVar ServerState -> Socket -> IO ()+talkGetPlay serverState conn = do+    st <- readMVar serverState+    if getStatus st == "Stopped" then+        sendString conn "-1"+    else+        sendString conn $ show $ shuffleFunc st $ getPlaying st++talkAdd :: MVar ServerState -> Socket -> IO ()+talkAdd serverState conn = do+    sendString conn "OK"+    file <- recvString conn+    sendString conn "OK"++    modifyMVar_ serverState $ \st -> do+        let (_, d) = State.runState shuffleAdd $ shuffleData st+        return st {+            getPlaylist = getPlaylist st ++ [file],+            shuffleData = d+        }++talkRemove :: MVar ServerState -> GstPlayer -> Socket -> IO ()+talkRemove serverState player conn = do+    sendString conn "OK"+    sIndex <- recvString conn+    sendString conn "OK"+    +    st <- takeMVar serverState+    let shuffleEnabled = isShuffleMode st+    let playing = getPlaying st+    let index = read sIndex :: Int+    let (_, d) = State.runState shuffleRemove $ shuffleData st+    putMVar serverState $ update index playing d st++    when (or [shuffleEnabled, playing == index]) $ playerPlay serverState player id++    where+        update index playing d st+            | index < playing  =+                  st {+                      getPlaying  = pred playing,+                      getPlaylist = removeAt index $ getPlaylist st,+                      shuffleData = d+                  }+            | otherwise =+                  st {+                      getPlaylist = removeAt index $ getPlaylist st,+                      shuffleData = d+                  }++talkClear :: MVar ServerState -> GstPlayer -> Socket -> IO ()+talkClear serverState player conn = do+    sendString conn "OK"+    gstPlayerStop player+    modifyMVar_ serverState (const $ return defaultServerState)++talkStop :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkStop serverState conn player = do+    sendString conn "OK"+    modifyMVar_ serverState $ flip modifyPlayerStop player++talkPause :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkPause serverState conn player = do+    sendString conn "OK"+    modifyMVar_ serverState $ \st -> do+        gstPlayerPause player+        return st {+            getStatus = "Paused"+        }++talkResume :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkResume serverState conn player = do+    sendString conn "OK"+    modifyMVar_ serverState $ \st -> do+        gstPlayerResume player+        return st {+            getStatus = "Playing"+        }++talkNext :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkNext serverState conn player = do+    sendString conn "OK"+    st <- takeMVar serverState+    let status = getStatus st+    let index  = succ $ getPlaying st+    let len    = length $ getPlaylist st+    let rpt    = isRepeatMode st+    putMVar serverState st++    if rpt then+        when (status == "Playing") $ playerPlay serverState player succ+    else+        when (and [status == "Playing", index < len]) $ playerPlay serverState player succ++talkPrev :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkPrev serverState conn player = do+    sendString conn "OK"+    st <- takeMVar serverState+    let status = getStatus st+    let index  = pred $ getPlaying st+    let rpt    = isRepeatMode st+    putMVar serverState st++    if rpt then+        when (status == "Playing") $ playerPlay serverState player pred+    else+        when (and [status == "Playing", index >= 0]) $ playerPlay serverState player pred++talkVolumeUp :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkVolumeUp serverState conn player = do+    sendString conn "OK"+    modifyMVar_ serverState $ \st -> do+        let vol0 = (getVolume st) + 0.04+        let vol1 = if vol0 > 1.0 then 1.0 else vol0+        gstPlayerSetVolume player vol1+        return st {+            getVolume = vol1+        }++talkVolumeDown :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkVolumeDown serverState conn player = do+    sendString conn "OK"+    modifyMVar_ serverState $ \st -> do+        let vol0 = (getVolume st) - 0.04+        let vol1 = if vol0 < 0.0 then 0.0 else vol0+        gstPlayerSetVolume player vol1+        return st {+            getVolume = vol1+        }++talkVolumeGet :: MVar ServerState -> Socket -> IO ()+talkVolumeGet serverState conn = do+    st <- readMVar serverState+    let vol = ceiling $ (getVolume st) * 100 :: Int+    sendString conn $ show vol++talkSeekForward :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkSeekForward serverState conn player = do+    sendString conn "OK"+    st <- readMVar serverState+    let pos0 = (getCurrentPosition st) + 15+    let pos1 = if pos0 > getCurrentDuration st then getCurrentDuration st else pos0+    gstPlayerSeek player pos1++talkSeekBackward :: MVar ServerState -> Socket -> GstPlayer -> IO ()+talkSeekBackward serverState conn player = do+    sendString conn "OK"+    st <- readMVar serverState+    let pos0 = (getCurrentPosition st) - 15+    let pos1 = if pos0 < 0 then 0 else pos0+    gstPlayerSeek player pos1++talkGetFlags :: MVar ServerState -> Socket -> IO ()+talkGetFlags serverState conn = do+    st <- readMVar serverState+    let r = if isRepeatMode st then 'r' else '-'+    let z = if isShuffleMode st then 'z' else '-'+    sendString conn $ [r, z]++talkToggleRepeat :: MVar ServerState -> Socket -> IO ()+talkToggleRepeat serverState conn = do+    sendString conn "OK"+    modifyMVar_ serverState $ \st -> do+        return st {+            isRepeatMode = not $ isRepeatMode st+        }++talkToggleShuffle :: MVar ServerState -> GstPlayer -> Socket -> IO ()+talkToggleShuffle serverState player conn = do+    sendString conn "OK"++    shuffleEnabled <- modifyMVar serverState $ \st -> do+        if isShuffleMode st then do+            newSt <- disableShuffle st+            return (newSt, False)+        else do+            newSt <- enableShuffle st+            return (newSt, getStatus st == "Playing")++    when (shuffleEnabled) $ playerPlay serverState player id++disableShuffle :: ServerState -> IO ServerState+disableShuffle st = +    return st {+        getPlaying = shuffleFunc st $ getPlaying st,+        isShuffleMode = False,+        shuffleFunc = id+    }++enableShuffle :: ServerState -> IO ServerState+enableShuffle st = do+    r <- randomIO+    let (f, d) = State.runState (shuffleFilled $ length $ getPlaylist st) $ shuffleInitial (mkStdGen r)+    return st {+        getPlaying = 0,+        isShuffleMode = True,+        randomInitializer = r,+        shuffleFunc = f,+        shuffleData = d+    }
+ src/Mp/Player/ServerState.hs view
@@ -0,0 +1,116 @@+{-  + *  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.Player.ServerState where++import qualified Control.Monad.State as State++import Data.Binary+import System.Random++import Mp.Utils.Shuffle+import Mp.Utils.Exception++data ServerState = ServerState {+    getPlaylist        :: ![String],+    getCurrentPosition :: !Integer,+    getCurrentDuration :: !Integer,+    getStatus          :: !String,+    getPlaying         :: !Int,+    getVolume          :: !Double,+    isRepeatMode       :: !Bool,+    isShuffleMode      :: !Bool,+    randomInitializer  :: !Int,+    shuffleFunc        :: Int -> Int,+    shuffleData        :: !ShuffleData+}++instance Binary ServerState where+    put st = do+        put (1113 :: Word32)+        put (0 :: Int)+        put $ getPlaying st+        if getStatus st == "Paused"+            then put "Playing"+            else put $ getStatus st+        put $ getVolume st+        put $ getPlaylist st+        put $ isRepeatMode st+        put $ isShuffleMode st+        put $ randomInitializer st++    get = do+        magic <- get :: Get Word32+        if magic /= 1113+            then return defaultServerState+            else do+                version <- get :: Get Int+                case version of+                    0 -> getVersion0+                    _ -> return defaultServerState+        where+            getVersion0 = do+                playing     <- get+                status      <- get+                volume      <- get+                playlist    <- get+                repeatMode  <- get+                shuffleMode <- get+                r           <- get++                let g = mkStdGen r+                let (f, d) = if shuffleMode then+                                 State.runState (shuffleFilled $ length playlist) $ shuffleInitial g+                             else+                                 (id, shuffleInitial g)++                return ServerState {+                    getPlaylist = playlist,+                    getCurrentPosition = 0,+                    getCurrentDuration = 0,+                    getStatus = status,+                    getPlaying = playing,+                    getVolume = volume,+                    isRepeatMode = repeatMode,+                    isShuffleMode = shuffleMode,+                    randomInitializer = r,+                    shuffleFunc = f,+                    shuffleData = d+                }++defaultServerState :: ServerState+defaultServerState = ServerState {+    getPlaylist = [],+    getCurrentPosition = 0,+    getCurrentDuration = 0,+    getStatus = "Stopped",+    getPlaying = -1,+    getVolume = 1.0,+    isRepeatMode = False,+    isShuffleMode = False,+    randomInitializer = 0,+    shuffleFunc = id,+    shuffleData = shuffleInitial $ mkStdGen 0+}++readStateFromFile :: String -> IO ServerState+readStateFromFile file = decodeFile file `catchAny` (\_ -> return defaultServerState)
+ src/Mp/UI/BrowserPage.hs view
@@ -0,0 +1,224 @@+{-  + *  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.UI.BrowserPage (+    BrowserPage (..),+    BrowserPageWidget,+    makeUIBrowserPage+) where++import Graphics.Vty.Widgets.All+import Graphics.Vty hiding (Button)++import qualified Data.HashMap.Strict as Map+import qualified Data.Text as T+import Data.ConfigFile+import Data.List+import Data.Maybe+import Data.Functor+import System.Directory+import System.FilePath.Posix+import Control.Monad+import Control.Concurrent++import Mp.Utils.Colors+import Mp.Utils.Exception+import Mp.Utils.Utils+import Mp.Configuration.Configuration+import Mp.UI.QueuePage++type BrowserPageWidget = Widget (List String FormattedText)++data BrowserPage = BrowserPage {+    browserPageWidget     :: BrowserPageWidget,+    browserPageFocusGroup :: Widget FocusGroup,+    browserPageReset      :: IO ()+}++data BrowserState = BrowserState {+    topDir   :: !String,+    dirCache :: Map.HashMap String String+}++makeUIBrowserPage :: ConfigParser -> QueuePage -> IO BrowserPage+makeUIBrowserPage conf queuePage = do+    fg <- newFocusGroup++    lst <- newList (browserActiveAttribute conf ) 1+           >>= withBrowserBgAttribute conf++    let musicDir = getMusicDirectory conf+    setCurrentDirectory musicDir++    browserState <- newMVar BrowserState {+        topDir = musicDir,+        dirCache = Map.empty+    }+    addAllFilesToList lst musicDir++    _ <- addToFocusGroup fg lst+    _ <- addToFocusGroup fg lst++    let keyHandler = \_ k _ ->+            case k of+                KEnter -> do+                    maybeSel <- getSelected lst+                    let (_, (value, _)) = fromJust maybeSel +                    modifyMVar_ browserState $ changeDirectory lst value+                    return True++                KASCII '!' -> do+                    modifyMVar_ browserState $ changeDirectory lst musicDir+                    return True++                KASCII '@' -> do+                    modifyMVar_ browserState $ changeDirectory lst ".."+                    return True++                KASCII ' ' -> do+                    selectCurrentFile lst+                    return True++                KASCII 'd' -> do+                    removeCurrentFile lst+                    return True++                _ -> return False++    lst `onKeyPressed` keyHandler++    return BrowserPage {+        browserPageWidget     = lst,+        browserPageFocusGroup = fg,+        browserPageReset      = resetBrowser lst browserState+    }+    where+        addFileToList list text = addToList list text =<< (plainText (T.pack text) >>= withBrowserFileAttribute conf)+        addDirToList list text = addToList list text =<< (plainText (T.pack text) >>= withBrowserDirectoryAttribute conf)++        addAllFilesToList list dir = do+            clearList list++            files <- sort <$> getDirectoryContents dir++            forM_ files $ \file -> do+                exists <- doesDirectoryExist $ dir </> file+                when (and [exists, file /= "."]) $ addDirToList list file++            forM_ files $ \file -> do+                exists <- doesFileExist $ dir </> file+                when exists $ addFileToList list file++        changeDirectory list dir st = do+            let oldDir = topDir st+            ok <- try' $ setCurrentDirectory $ oldDir </> dir+            if (isJust ok)+                then do+                    newDir <- getCurrentDirectory+                    let newSt = if dir == ".."+                                    then+                                        st {+                                            topDir = newDir+                                        }+                                    else+                                        st {+                                            topDir   = newDir,+                                            dirCache = Map.insert oldDir dir $ dirCache st+                                        }+                    addAllFilesToList list newDir+                    when (dir == "..") $ do+                        let maybeVal = Map.lookup newDir $ dirCache newSt+                        when (isJust maybeVal) $ do+                            maybeIndex <- listFindFirst list $ fromJust maybeVal+                            case maybeIndex of+                                Just index -> setSelected list index+                                Nothing    -> return ()+                    return newSt+                else+                    return st++        selectCurrentFile list = do+            maybeSel <- getSelected list+            when (isJust maybeSel) $ do+                let (index, (file, item)) = fromJust maybeSel+                currDir <- getCurrentDirectory+                when (currDir /= "..") $ do+                    _ <- withBrowserSelectedAttribute conf item+                    setSelected list $ succ index+                    addAllFiles currDir file+                    return ()++        addAllFiles dir file+            | file == "."  = return ()+            | file == ".." = return ()+            | otherwise    = do+                exists <- doesDirectoryExist $ dir </> file+                if exists+                    then do+                        let newDir = dir </> file+                        files <- try' (sort <$> getDirectoryContents newDir)+                        when (isJust files) $ do+                            forM_ (fromJust files) $ \f -> do+                                addAllFiles newDir f+                    else+                        queuePageAdd queuePage dir file++        removeCurrentFile list = do+            maybeSel <- getSelected list+            when (isJust maybeSel) $ do+                let (index, (file, item)) = fromJust maybeSel+                currDir <- getCurrentDirectory+                when (currDir /= "..") $ do+                    whenM (doesDirectoryExist $ currDir </> file) $ do+                        _ <- withBrowserDirectoryAttribute conf item+                        return ()++                    whenM (doesFileExist $ currDir </> file) $ do+                        _ <- withBrowserFileAttribute conf item+                        return ()++                    setSelected list $ succ index+                    removeAllFiles currDir file+                    return ()++        removeAllFiles dir file+            | file == "."  = return ()+            | file == ".." = return ()+            | otherwise    = do+                exists <- doesDirectoryExist $ dir </> file+                if exists+                    then do+                        let newDir = dir </> file+                        files <- try' (sort <$> getDirectoryContents newDir)+                        when (isJust files) $ do+                            forM_ (fromJust files) $ \f -> do+                                removeAllFiles newDir f+                    else+                        queuePageRemove queuePage dir file++        resetBrowser widget browserState = do+            st       <- readMVar browserState+            maybeSel <- getSelected widget+            addAllFilesToList widget $ topDir st+            when (isJust maybeSel) $ do+                let (sel, _) = fromJust maybeSel+                setSelected widget sel
+ src/Mp/UI/EditBar.hs view
@@ -0,0 +1,60 @@+{-  + *  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.EditBar (+    EditBar (..),+    EditBarWidget,+    makeUIEditBar+) where++import qualified Data.Text as T+import Control.Applicative++import Graphics.Vty.Widgets.All+import Graphics.Vty hiding (Button)++import Data.ConfigFile++import Mp.Utils.Colors++type EditBarWidget = Widget Edit++data EditBar = EditBar {+    editBarWidget       :: EditBarWidget,+    editBarGetText      :: IO String,+    editBarReset        :: IO (),+    editBarOnKeyPressed :: (Widget Edit -> Key -> [Modifier] -> IO Bool) -> IO ()+}++makeUIEditBar :: ConfigParser -> IO EditBar+makeUIEditBar conf = do+    edit <- editWidget+            >>= withEditAttribute conf++    return EditBar {+        editBarWidget       = edit,+        editBarGetText      = T.unpack <$> getEditText edit,+        editBarReset        = setEditText edit "",+        editBarOnKeyPressed = onKeyPressed edit+    }
+ src/Mp/UI/HelpPage.hs view
@@ -0,0 +1,147 @@+{-  + *  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.UI.HelpPage (+    HelpPage (..),+    HelpPageWidget,+    makeUIHelpPage+) where++import Graphics.Vty.Widgets.All+import Graphics.Vty hiding (Button)+import Data.ConfigFile+import Control.Monad++import qualified Data.Text as T++import Mp.Utils.Colors+import Mp.Utils.I18N++type HelpPageWidget = Widget (List String FormattedText)++data HelpPage = HelpPage {+    helpPageWidget     :: HelpPageWidget,+    helpPageFocusGroup :: Widget FocusGroup+}++makeUIHelpPage :: ConfigParser -> IO HelpPage+makeUIHelpPage conf = do+    fg <- newFocusGroup++    lst <- newList (helpAttribute conf) 1+           >>= withHelpAttribute conf++    makeHelpContent lst+    setSelected lst 0++    _ <- addToFocusGroup fg lst+    _ <- addToFocusGroup fg lst++    let keyHandler = \_ k _ -> do+            size <- getCurrentSize lst+            let height = fromIntegral $ region_height size+            sel <- getSelected lst+            case sel of+                Just (index, _) ->+                    case k of+                        KUp       -> do+                            scrollPageUp lst height index+                            return True+                        KDown     -> do+                            scrollPageDown lst height index+                            return True+                        KPageUp   -> do+                            scrollPageUp lst height index+                            return True+                        KPageDown -> do+                            scrollPageDown lst height index+                            return True+                        _         ->+                            return False+                Nothing         ->+                    return False++    fg `onKeyPressed` keyHandler++    return HelpPage {+        helpPageWidget     = lst,+        helpPageFocusGroup = fg+    }++    where+        line list text = addToList list "" =<< (plainText (T.pack text) >>= withHelpAttribute conf)++        scrollPageUp list height index = do+            scrollToBeginning list+            scrollBy list $ height + index+            setSelected list $ pred index++        scrollPageDown list height index = do+            listLength <- getListSize list+            when (index < listLength - height) $ do+                scrollToBeginning list+                scrollBy list $ height + index+                setSelected list $ succ index++        makeHelpContent list = do+            let ln = line list+            ln   " "+            ln $ "          q : " ++ (__ "Detach from the server")+            ln $ "          Q : " ++ (__ "Quit")+            ln $ ""+            ln $ "          1 : " ++ (__ "Help screen")+            ln $ "          2 : " ++ (__ "Queue screen")+            ln $ "          3 : " ++ (__ "Playlists screen")+            ln $ "          4 : " ++ (__ "Browser screen")+            ln $ ""+            ln $ "        Tab : " ++ (__ "Next screen")+            ln $ "  Shift+Tab : " ++ (__ "Previous screen")+            ln $ ""+            ln $ "         Up : " ++ (__ "Move cursor up")+            ln $ "       Down : " ++ (__ "Move cursor down")+            ln $ "     PageUp : " ++ (__ "Page up")+            ln $ "   PageDown : " ++ (__ "Page down")+            ln $ ""+            ln $ "      Enter : " ++ (__ "Start playing / Enter directory / Enter playlist")+            ln $ "          s : " ++ (__ "Stop playing")+            ln $ "          p : " ++ (__ "Pause / resume playing")+            ln $ ""+            ln $ "      space : " ++ (__ "Add file / directory / playlist")+            ln $ "          d : " ++ (__ "Remove file / directory / playlist")+            ln $ "          c : " ++ (__ "Clear the queue")+            ln $ "          l : " ++ (__ "Center")+            ln $ "          S : " ++ (__ "Save playlist")+            ln $ "     Ctrl+d : " ++ (__ "Delete playlist")+            ln $ "          ! : " ++ (__ "Go to root directory")+            ln $ "          @ : " ++ (__ "Go to parent directory")+            ln $ ""+            ln $ "          > : " ++ (__ "Play next file")+            ln $ "          < : " ++ (__ "Play previous file")+            ln $ "          f : " ++ (__ "Seek forward")+            ln $ "          b : " ++ (__ "Seek backward")+            ln $ ""+            ln $ "          r : " ++ (__ "Toggle repeat mode")+            ln $ "          z : " ++ (__ "Toggle random mode")+            ln $ ""+            ln $ "          [ : " ++ (__ "Decrease volume")+            ln $ "          ] : " ++ (__ "Increase volume")+            ln   " "
+ src/Mp/UI/Main.hs view
@@ -0,0 +1,203 @@+{-  + *  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.Main (+    makeAndRunUI+) where++import System.Exit+import System.Directory+import System.FilePath.Posix+import System.Posix.Signals+import Graphics.Vty hiding (Button)+import Graphics.Vty.Widgets.All+import Control.Concurrent++import Mp.Configuration.Configuration+import Mp.UI.HelpPage+import Mp.UI.QueuePage+import Mp.UI.PlaylistPage+import Mp.UI.BrowserPage+import Mp.UI.Menu+import Mp.UI.StatusBar+import Mp.UI.EditBar+import Mp.Utils.I18N+import Mp.Player.Client++makeAndRunUI :: IO ()+makeAndRunUI = do+    _ <- installHandler sigINT  (Catch $ schedule shutdownUi) Nothing+    _ <- installHandler sigHUP  (Catch $ schedule shutdownUi) Nothing+    _ <- installHandler sigABRT (Catch $ schedule shutdownUi) Nothing+    _ <- installHandler sigTERM (Catch $ schedule shutdownUi) Nothing++    conf <- readConfiguration++    menu <- makeUIMenu conf+    status <- makeUIStatusBar conf+    edit   <- makeUIEditBar conf++    helpPage     <- makeUIHelpPage conf+    queuePage    <- makeUIQueuePage conf status+    playlistPage <- makeUIPlaylistPage conf queuePage+    browserPage  <- makeUIBrowserPage conf queuePage++    let fg1 = helpPageFocusGroup helpPage+    let fg2 = queuePageFocusGroup queuePage+    let fg3 = playlistPageFocusGroup playlistPage+    let fg4 = browserPageFocusGroup browserPage++    _ <- addToFocusGroup fg2 $ editBarWidget edit++    ui1 <- makeUI menu status edit $ helpPageWidget helpPage+    ui2 <- makeUI menu status edit $ queuePageWidget queuePage+    ui3 <- makeUI menu status edit $ playlistPageWidget playlistPage+    ui4 <- makeUI menu status edit $ browserPageWidget browserPage++    c <- newCollection++    switchToUI1 <- addToCollection c ui1 fg1+    switchToUI2 <- addToCollection c ui2 fg2+    switchToUI3 <- addToCollection c ui3 fg3+    switchToUI4 <- addToCollection c ui4 fg4++    active  <- newMVar 1 :: IO (MVar Int)+    enabled <- newMVar True++    let makeActive = makeActiveFunction active menu [switchToUI1, switchToUI2, switchToUI3, switchToUI4]+    makeActive 1++    let keyHandler = \_ k _ -> do+            e <- readMVar enabled+            if (not e) then return False+            else+                case k of+                    KASCII '\t' -> do+                        index <- readMVar active+                        makeActive $ (succ index) `mod` 4+                        return True+                    KBackTab    -> do+                        index <- readMVar active+                        makeActive $ (pred index) `mod` 4+                        return True+                    KASCII ']'  -> do+                        clientSendVolumeUp+                        return True+                    KASCII '['  -> do+                        clientSendVolumeDown+                        return True+                    KASCII 'q'  -> exitSuccess+                    KASCII 'Q'  -> clientSendQuitMessage >> exitSuccess+                    KASCII '1'  -> makeActive 0 >> return True+                    KASCII '2'  -> makeActive 1 >> return True+                    KASCII '3'  -> makeActive 2 >> playlistReset playlistPage >> return True+                    KASCII '4'  -> makeActive 3 >> browserPageReset browserPage >> return True+                    _           -> return False++    question <- newMVar False+    let editHandler = \_ k _ -> do+            q <- readMVar question++            name <- editBarGetText edit+            list <- queuePageGetAll queuePage+            plsDir <- playlistDirFilePath++            if q then+                case k of+                    KASCII 'y' -> do+                        restoreFocus status edit fg2 question enabled+                        playlistAdd playlistPage True name list+                        return True++                    KASCII 'Y' -> do+                        restoreFocus status edit fg2 question enabled+                        playlistAdd playlistPage True name list+                        return True++                    KASCII 'n' -> do+                        restoreFocus status edit fg2 question enabled+                        return True++                    KASCII 'N' -> do+                        restoreFocus status edit fg2 question enabled+                        return True++                    KEsc       -> do+                        restoreFocus status edit fg2 question enabled+                        return True++                    _          -> return True+            else+                case k of+                    KEsc   -> do+                        restoreFocus status edit fg2 question enabled+                        return True++                    KEnter -> do+                        modifyMVar_ enabled $ const (return True)++                        exists <- doesFileExist $ plsDir </> name+                        if exists then do+                            statusBarSetText status (__ "File exists. Overwrite (Y/N) ?")+                            modifyMVar_ question $ const (return True)+                        else do+                            playlistAdd playlistPage False name list+                            restoreFocus status edit fg2 question enabled+                        return True++                    _      -> return False++    let queueHandler = \_ k _ ->+            case k of+                KASCII 'S' -> do+                    modifyMVar_ enabled $ const (return False)+                    statusBarSetText status (__ "Enter playlist name:")+                    focus $ editBarWidget edit+                    return True++                _ -> return False++    fg1 `onKeyPressed` keyHandler+    fg2 `onKeyPressed` keyHandler+    fg3 `onKeyPressed` keyHandler+    fg4 `onKeyPressed` keyHandler++    edit `editBarOnKeyPressed` editHandler+    fg2 `onKeyPressed` queueHandler++    runUi c defaultContext+    where+        makeUI menu status edit widget = return (menuWidget menu) <--> return widget <--> return (statusBarWidget status) <--> return (editBarWidget edit)++        makeActiveFunction active menu switches = \index -> do+            menuActivate menu index+            _ <- (!!) switches index+            modifyMVar_ active (const $ return index)++        restoreFocus status edit fg2 question enabled = do+            modifyMVar_ question $ const (return False)+            modifyMVar_ enabled $ const (return True)+            focusPrevious fg2+            statusBarReset status+            editBarReset edit
+ src/Mp/UI/Menu.hs view
@@ -0,0 +1,68 @@+{-  + *  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.UI.Menu (+    Menu (..),+    MenuWidget,+	makeUIMenu+) where++import qualified Data.Text as T++import Graphics.Vty.Widgets.All+import Data.ConfigFile++import Mp.Utils.Colors+import Mp.Utils.I18N++type MenuWidget = (Widget (Box (Box (Box (Box FormattedText FormattedText) FormattedText) FormattedText) HFill))++data Menu = Menu {+    menuWidget   :: MenuWidget,+    menuActivate :: Int -> IO ()+}++activateMenu :: [Widget a] -> ConfigParser -> Int -> IO ()+activateMenu m_list conf n = do+    mapM_ (withTabAttribute conf) m_list+    _ <- withTabActiveAttribute conf $ m_list !! n+    return ()++makeUIMenu :: ConfigParser -> IO Menu+makeUIMenu conf = do+    m1 <- plainText (T.pack $ __ " [1]   Help     ")+          >>= withTabAttribute conf+    m2 <- plainText (T.pack $ __ " [2]  Queue     ")+          >>= withTabAttribute conf+    m3 <- plainText (T.pack $ __ " [3] Playlists  ")+          >>= withTabAttribute conf+    m4 <- plainText (T.pack $ __ " [4]  Browser   ")+          >>= withTabAttribute conf+    m5 <- hFill ' ' 1+          >>= withTabAttribute conf++    menu <- return m1 <++> return m2 <++> return m3 <++> return m4 <++> return m5++    return Menu {+        menuWidget   = menu,+        menuActivate = activateMenu [m1, m2, m3, m4] conf+    }
+ src/Mp/UI/PlaylistPage.hs view
@@ -0,0 +1,263 @@+{-  + *  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.PlaylistPage (+    PlaylistPage (..),+    PlaylistPageWidget,+    makeUIPlaylistPage+) where++import qualified Data.HashMap.Strict as Map+import qualified Data.Binary as B+import qualified Data.Text as T++import Control.Concurrent+import Control.Monad+import Data.ConfigFile+import Data.Maybe+import Graphics.Vty.Widgets.All+import Graphics.Vty hiding (Button)+import System.FilePath.Posix+import System.Directory++import Mp.Utils.Colors+import Mp.Utils.Exception+import Mp.Utils.Utils+import Mp.Configuration.Configuration+import Mp.UI.PlaylistState+import Mp.UI.QueuePage++type PlaylistPageWidget = Widget (List String FormattedText)++data PlaylistPage = PlaylistPage {+    playlistPageWidget     :: PlaylistPageWidget,+    playlistPageFocusGroup :: Widget FocusGroup,+    playlistAdd            :: Bool -> String -> [String] -> IO (),+    playlistReset          :: IO ()+}++data PlaylistState = PlaylistState {+     playlistNames :: ![String],+     playlistMap   :: Map.HashMap String [String],+     index         :: !Int+}++makeUIPlaylistPage :: ConfigParser -> QueuePage -> IO PlaylistPage+makeUIPlaylistPage conf queuePage = do+    playlistState <- newMVar PlaylistState {+        playlistNames = [],+        playlistMap   = Map.empty,+        index         = -1+    }++    fg <- newFocusGroup++    lst <- newList (playlistActiveAttribute conf) 1+           >>= withPlaylistBgAttribute conf++    _ <- addToFocusGroup fg lst+    _ <- addToFocusGroup fg lst++    let keyHandler = \_ k ms ->+            case k of+                KASCII ' ' -> do+                    maybeSel <- getSelected lst+                    st <- readMVar playlistState+                    when (isJust maybeSel) $ do+                        let (idx, (value, item)) = fromJust maybeSel+                        _ <- withPlaylistSelectedAttribute conf item+                        if (index st == -1) then do+                            let maybePlaylist = Map.lookup value $ playlistMap st+                            when (isJust maybePlaylist) $+                                forM_ (fromJust maybePlaylist) $ \path -> do+                                    let (dir, file) = separateFilePath path+                                    queuePageAdd queuePage dir file+                        else do+                            let maybePlaylist = Map.lookup (playlistNames st !! index st) $ playlistMap st+                            when (isJust maybePlaylist) $ do+                                let (dir, file) = separateFilePath $ (fromJust maybePlaylist) !! pred idx+                                queuePageAdd queuePage dir file+                        setSelected lst $ succ idx+                    return True++                KASCII 'd' -> do+                    st       <- readMVar playlistState+                    maybeSel <- getSelected lst+                    when (isJust maybeSel) $ do+                        let (idx, (value, item)) = fromJust maybeSel+                        if any (MCtrl == ) ms then         -- remove playlist+                            when (index st == -1) $ playlistRemoveAndDelete playlistState lst idx+                        else do                            -- delete from queue list+                            if (index st == -1) then do+                                _ <- withPlaylistNameAttribute conf item+                                let maybePlaylist = Map.lookup value $ playlistMap st+                                when (isJust maybePlaylist) $+                                    forM_ (fromJust maybePlaylist) $ \path -> do+                                        let (dir, file) = separateFilePath path+                                        queuePageRemove queuePage dir file+                            else do+                                _ <- withPlaylistFileAttribute conf item+                                let maybePlaylist = Map.lookup (playlistNames st !! index st) $ playlistMap st+                                when (isJust maybePlaylist) $ do+                                    let (dir, file) = separateFilePath $ (fromJust maybePlaylist) !! pred idx+                                    queuePageRemove queuePage dir file+                            setSelected lst $ succ idx+                    return True++                KASCII '!' -> do+                    modifyMVar_ playlistState $ \st -> do+                        if index st == -1 then+                            return st+                        else do+                            showNames lst st+                            setSelected lst $ index st+                            return st {+                                index = -1+                            }+                    return True++                KASCII '@' -> do+                    modifyMVar_ playlistState $ \st -> do+                        if index st == -1 then+                            return st+                        else do+                            showNames lst st+                            setSelected lst $ index st+                            return st {+                                index = -1+                            }+                    return True++                KEnter     -> do+                    maybeSel <- getSelected lst+                    when (isJust maybeSel) $ do+                        let (idx, (value, _)) = fromJust maybeSel+                        if (and [value == "..", idx == 0]) then+                            modifyMVar_ playlistState $ \st -> do+                                showNames lst st+                                setSelected lst $ index st+                                return st {+                                    index = -1+                                }+                        else+                            modifyMVar_ playlistState $ \st -> do+                                if (index st == -1) then do+                                    showFiles lst st value+                                    return st {+                                        index = idx+                                    }+                                else+                                    return st+                    return True++                _          -> return False++    lst `onKeyPressed` keyHandler++    readPlaylist playlistState lst++    return PlaylistPage {+        playlistPageWidget     = lst,+        playlistPageFocusGroup = fg,+        playlistAdd            = playlistAddAndSave playlistState lst,+        playlistReset          = reset playlistState lst+    }++    where+        addNameTo widget name = addToList widget name =<< (plainText (T.pack name) >>= withPlaylistNameAttribute conf)++        addFileTo widget name = addToList widget name =<< (plainText (T.pack name) >>= withPlaylistFileAttribute conf)+        +        reset playlistState widget = do+            st       <- readMVar playlistState+            maybeSel <- getSelected widget+            if (index st == -1) then showNames widget st+            else showFiles widget st (playlistNames st !! index st)+            when (isJust maybeSel) $ do+                let (sel, _) = fromJust maybeSel+                setSelected widget sel++        showNames widget st = do+            clearList widget+            forM_ (playlistNames st) $ addNameTo widget++        showFiles widget st name = do+            clearList widget+            addNameTo widget ".."+            let maybePlaylist = Map.lookup name $ playlistMap st+            when (isJust maybePlaylist) $+                forM_ (fromJust maybePlaylist) $ \path -> do+                    let (_, file) = separateFilePath path+                    addFileTo widget file++        playlistAddState playlistState widget name list = do+            modifyMVar_ playlistState $ \st -> do+                when (index st == -1) $ addNameTo widget name+                return st {+                    playlistNames = playlistNames st ++ [name],+                    playlistMap   = Map.insert name list $ playlistMap st+                }++        playlistAddAndSave playlistState widget overwrite name list =+            when (not $ null name) $ do+                when (not overwrite) $ do playlistAddState playlistState widget name list+                cfgDir <- configDirFilePath+                plsDir <- playlistDirFilePath+                playlistSave playlistState cfgDir plsDir name list++        playlistSave playlistState cfgDir plsDir name list = do+            st <- readMVar playlistState+            B.encodeFile (cfgDir </> "playlists.state") (NameList $ playlistNames st)+            B.encodeFile (plsDir </> name) $ SongList list++        playlistRemoveAndDelete playlistState widget idx = do+            cfgDir <- configDirFilePath+            plsDir <- playlistDirFilePath+            st <- readMVar playlistState+            _ <- removeFromList widget idx+            playlistDelete playlistState cfgDir plsDir $ playlistNames st !! idx+            playlistRemoveState playlistState idx++        playlistRemoveState playlistState idx = do+            modifyMVar_ playlistState $ \st -> do+                let name = playlistNames st !! idx+                return st {+                    playlistNames = removeAt idx $ playlistNames st,+                    playlistMap = Map.delete name $ playlistMap st+                }++        playlistDelete playlistState cfgDir plsDir name = do+            st <- readMVar playlistState+            B.encodeFile (cfgDir </> "playlists.state") (NameList $ playlistNames st)+            removeFile (plsDir </> name)++        readPlaylist playlistState widget = do+            cfgDir <- configDirFilePath+            plsDir <- playlistDirFilePath+            maybeNames <- try' (B.decodeFile (cfgDir </> "playlists.state") :: IO NameList)+            when (isJust maybeNames) $ do+                forM_ (nameListGet $ fromJust maybeNames) $ \name -> do+                    maybePlaylist <- try' (B.decodeFile (plsDir </> name) :: IO SongList)+                    when (isJust maybePlaylist) $ do+                        playlistAddState playlistState widget name $ songListGet $ fromJust maybePlaylist
+ src/Mp/UI/PlaylistState.hs view
@@ -0,0 +1,73 @@+{-  + *  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.UI.PlaylistState where++import Data.Binary++data NameList = NameList {+    nameListGet :: [String]+}++data SongList = SongList {+    songListGet :: [String]+}++instance Binary NameList where+    put (NameList d) = do+        put (011110 :: Word32)+        put (0 :: Int)+        put d++    get = do+        magic <- get :: Get Word32+        if magic /= 011110+            then return $ NameList []+            else do+                version <- get :: Get Int+                case version of+                    0 -> getVersion0+                    _ -> return $ NameList []+        where+            getVersion0 = do+                list <- get+                return $ NameList list++instance Binary SongList where+    put (SongList d) = do+        put (13131717 :: Word32)+        put (0 :: Int)+        put d++    get = do+        magic <- get :: Get Word32+        if magic /= 13131717+            then return $ SongList []+            else do+                version <- get :: Get Int+                case version of+                    0 -> getVersion0+                    _ -> return $ SongList []+        where+            getVersion0 = do+                list <- get+                return $ SongList list
+ src/Mp/UI/QueuePage.hs view
@@ -0,0 +1,220 @@+{-  + *  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.UI.QueuePage (+    QueuePage (..),+    QueuePageWidget,+    AddToFunction,+    RemoveFromFunction,+    makeUIQueuePage+) where++import Data.ConfigFile (ConfigParser)+import qualified Data.Text as T+import System.FilePath.Posix+import Data.Maybe+import Control.Monad+import Control.Concurrent++import Graphics.Vty.Widgets.All+import Graphics.Vty hiding (Button)++import Mp.Utils.Colors+import Mp.Utils.Exception+import Mp.Utils.Utils+import Mp.Player.Client+import Mp.UI.StatusBar++type QueuePageWidget = Widget (List String FormattedText)+type AddToFunction = String -> String -> IO ()+type RemoveFromFunction = String -> String -> IO ()++data QueuePage = QueuePage {+    queuePageWidget     :: QueuePageWidget,+    queuePageFocusGroup :: Widget FocusGroup,+    queuePageAdd        :: String -> String -> IO (),+    queuePageRemove     :: String -> String -> IO (),+    queuePageGetAll     :: IO [String]+}++makeUIQueuePage :: ConfigParser -> StatusBar -> IO QueuePage+makeUIQueuePage conf status = do+    fg <- newFocusGroup++    lst <- newList (queueActiveAttribute conf) 1+           >>= withQueueBgAttribute conf++    _ <- addToFocusGroup fg lst+    _ <- addToFocusGroup fg lst++    empty <- plainText $ T.pack ""+    playingItem <- newMVar empty++    let keyHandler = \_ k _ ->+            case k of+                KASCII '>' -> do+                    clientSendPlayNext+                    centerList lst+                    return True++                KASCII '<' -> do+                    clientSendPlayPrev+                    centerList lst+                    return True++                KASCII 'c' -> do+                    clearList lst+                    clientSendClear+                    return True++                KASCII 'l' -> do+                    centerList lst+                    return True++                KASCII 'd' -> do+                    maybeSel <- getSelected lst+                    when (isJust maybeSel) $ do+                        let (index, _) = fromJust maybeSel+                        rmFromList2 lst index+                    return True++                KASCII 's' -> do+                    clientSendStopPlaying+                    return True++                KASCII 'r' -> do+                    clientSendToggleRepeat+                    return True++                KASCII 'z' -> do+                    clientSendToggleShuffle+                    return True++                KASCII 'p' -> do+                    stat <- statusBarServerStatus status+                    case stat of+                        "Paused"  -> do+                            clientSendResumePlaying+                            return True++                        "Playing" -> do+                            clientSendPausePlaying+                            return True++                        _         -> return True++                KASCII 'f' -> do+                    clientSendSeekForward+                    return True++                KASCII 'b' -> do+                    clientSendSeekBackward+                    return True++                KEnter -> do+                    maybeSel <- getSelected lst+                    when (isJust maybeSel) $ do+                        let (index, _) = fromJust maybeSel+                        clientSendSetPlaying index+                    centerList lst+                    return True++                _ -> return False++    lst `onKeyPressed` keyHandler+    scheduleReceiveFromServer lst playingItem+    _ <- scheduleStatusFromServer lst playingItem++    return QueuePage {+        queuePageWidget     = lst,+        queuePageFocusGroup = fg,+        queuePageAdd        = addFileAndSend lst,+        queuePageRemove     = rmFromList lst,+        queuePageGetAll     = getList lst+    }+    where+        addFileToList list dir file = addToList list (dir </> file) =<< (plainText (T.pack file) >>= withQueueFileAttribute conf)++        addFileAndSend list dir file = do+            addFileToList list dir file++            clientSendAddFile $ dir </> file++        getList widget = do+            size <- getListSize widget++            items <- forM [0 .. (size - 1)] $ \i -> do+                maybeItem <- getListItem widget i+                let (value, _) = fromJust maybeItem+                return value+            return items++        selectItem list playingItem index = do+            maybeItem <- getListItem list index+            when (isJust maybeItem) $+                modifyMVar_ playingItem $ \oldWidget -> do+                    let (_, widget) = fromJust maybeItem+                    _ <- withQueueFileAttribute conf oldWidget  -- deselect old widget+                    _ <- withQueueSelectedAttribute conf widget -- select new widget+                    return widget                               -- selected widget++        rmFromList2 list index = do+            _ <- removeFromList list index+            clientSendRemove index++        rmFromList list dir file = do+            indexes <- listFindAll list $ dir </> file+            when (not $ null indexes) $ rmFromList2 list $ last indexes++        centerList widget = do+            index <- clientSendGetPlaying+            centerListAt widget index++        centerListAt widget index =+            when (index /= -1) $ do+                size <- getCurrentSize widget+                scrollToBeginning widget+                let height = fromIntegral $ region_height size+                let offset = index + (height `div` 2)+                when (offset > 0) $ scrollBy widget offset+                setSelected widget index++        receiveFromServer list playingItem = do+            items <- clientSendGetPlaylist+            index <- clientSendGetPlaying+            clearList list++            forM_ items $ \i -> do+                let (dir, file) = separateFilePath i+                addFileToList list dir file+            selectItem list playingItem index+            centerListAt list index++        scheduleReceiveFromServer list playingItem = schedule $ do+            success <- try' $ receiveFromServer list playingItem+            when (not $ isJust success) $ scheduleReceiveFromServer list playingItem++        scheduleStatusFromServer list playingItem = forkIO $ forever $ do+            threadDelay 100000+            schedule $ do+                success <- try' $ clientSendGetPlaying+                when (isJust success) $ selectItem list playingItem $ fromJust success
+ src/Mp/UI/StatusBar.hs view
@@ -0,0 +1,106 @@+{-  + *  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"
+ src/Mp/Utils/Colors.hs view
@@ -0,0 +1,184 @@+{-  + *  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
+ src/Mp/Utils/Exception.hs view
@@ -0,0 +1,31 @@+{-  + *  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.Exception where++import Control.Exception++catchAny :: IO a -> (SomeException -> IO a) -> IO a+catchAny = catch++try' :: IO a -> IO (Maybe a)+try' action = (action >>= return . Just) `catchAny` \_ -> return Nothing
+ src/Mp/Utils/I18N.hs view
@@ -0,0 +1,29 @@+{-  + *  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.I18N where++import Text.I18N.GetText+import System.IO.Unsafe++__ :: String -> String+__ = unsafePerformIO . getText
+ src/Mp/Utils/Network.hs view
@@ -0,0 +1,38 @@+{-  + *  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.Network where++import Network.Socket hiding (send, sendTo, recv, recvFrom)+import Network.Socket.ByteString+import Data.ByteString.UTF8++recvString :: Socket -> IO String+recvString sock = do+    rval <- recv sock 4096+    return $ toString rval++recvString_ :: Socket -> IO ()+recvString_ sock = recvString sock >> return ()++sendString :: Socket -> String -> IO ()+sendString sock msg = sendAll sock $ fromString msg
+ src/Mp/Utils/Shuffle.hs view
@@ -0,0 +1,90 @@+{-  + *  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.Shuffle (+    ShuffleData,+    ShuffleValue,+    ShuffleState,+    shuffleInitial,+    shuffleEmpty,+    shuffleFilled,+    shuffleAdd,+    shuffleRemove,+    shuffleFunction+) where++import Control.Monad.State+import System.Random+import Data.List++type ShuffleData  = (StdGen, Bool, Int, [(Int, Int)], [(Int, Int)])+type ShuffleValue = Int -> Int+type ShuffleState = State ShuffleData ShuffleValue++sortFunction :: (Int, Int) -> (Int, Int) -> Ordering+sortFunction (a, _) (b, _)+    | a < b     = LT+    | a > b     = GT+    | otherwise = EQ++shuffleInitial :: StdGen -> ShuffleData+shuffleInitial g = (g, True, 0, [], [])++shuffleEmpty :: ShuffleState+shuffleEmpty = return id++shuffleFilled :: Int -> ShuffleState+shuffleFilled ln = do+    forM_ [1..ln] $ \_ ->+        shuffleAdd+    shuffleFunction++shuffleAdd :: ShuffleState+shuffleAdd = do+    (g0, _, index, list, sorted) <- get+    let (r, g1) = random g0+    put (g1, True, succ index, (r, index) : list, sorted)+    return id++shuffleRemove :: ShuffleState+shuffleRemove = do+    (g0, _, index, list, sorted) <- get+    if (index == 0) then+        return id+    else do+        put (g0, True, pred index, tail list, sorted)+        return id++shuffleFunction :: ShuffleState+shuffleFunction = do+    (g0, changed, index, list, sorted) <- get+    if changed+        then do+            let newList = sortBy sortFunction list+            put (g0, False, index, list, newList)+            return $ \i ->+                if i < 0 then i+                else snd (newList !! i)+        else+            return $ \i ->+                if i < 0 then i+                else snd (sorted !! i)
+ src/Mp/Utils/Utils.hs view
@@ -0,0 +1,72 @@+{-  + *  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.Utils where++import Graphics.Vty+import Control.Monad++toVtyColor :: String -> (Color, Style)+toVtyColor color = case color of+    "black"         -> (black,   dim)+    "white"         -> (white,   dim)+    "cyan"          -> (cyan,    dim)+    "magenta"       -> (magenta, dim)+    "blue"          -> (blue,    dim)+    "yellow"        -> (yellow,  dim)+    "green"         -> (green,   dim)+    "red"           -> (red,     dim)+    "brightBlack"   -> (black,   bold)+    "brightYellow"  -> (yellow,  bold)+    "brightGreen"   -> (green,   bold)+    "brightRed"     -> (red,     bold)+    "brightBlue"    -> (blue,    bold)+    "brightWhite"   -> (white,   bold)+    "brightCyan"    -> (cyan,    bold)+    "brightMagenta" -> (magenta, bold)+    _               -> (black,   dim)++whenM :: Monad m => m Bool -> m () -> m ()+whenM cond action = do+    b <- cond+    when b action++timeToString :: Integer -> String+timeToString time =+    let h  = time `div` 3600+        m  = show $ (time `div` 60) `mod` 60+        m' = if (length m < 2) then "0" ++ m+             else m+        s  = show $ time `mod` 60+        s' = if (length s < 2) then "0" ++ s+             else s+    in+        if h == 0 then m ++ ":" ++ s'+        else (show h) ++ ":" ++ m' ++ ":" ++ s'++separateFilePath :: String -> (String, String)+separateFilePath file =+    let (f, d) = span (/= '/') $ reverse file+    in ((reverse $ tail d), (reverse f))++removeAt :: Int -> [a] -> [a]+removeAt index list = take index list ++ drop (succ index) list