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