{- * Programmer: Piotr Borek * E-mail: piotrborek@op.pl * Copyright 2018 Piotr Borek * * Distributed under the terms of the GPL (GNU Public License) * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {-# LANGUAGE TemplateHaskell #-} module Mp.UI.QueuePage ( QueuePageClass, QueuePage, castToQueuePage, queuePageNew ) where import Control.Lens (ix, makeLensesFor, (^?)) import Control.Monad import Control.Monad.Catch import qualified Graphics.Vty as Vty import Simple.UI.All import Mp.Player.Client import Mp.UI.MpData import Mp.Utils.Utils data QueuePage = QueuePage { _queuePageParent :: Widget , _queuePageSongIndex :: Attribute Int } makeLensesFor [("_queuePageParent", "queuePageParent")] ''QueuePage class QueuePageClass w where castToQueuePage :: w -> QueuePage instance QueuePageClass QueuePage where castToQueuePage = id instance WidgetClass QueuePage where castToWidget = _queuePageParent overrideWidget = overrideWidgetHelper queuePageParent queuePageNew :: UIApp MpData QueuePage queuePageNew = do mpData <- view appUserData songIndex <- attributeNew (-1 :: Int) textListView <- textListViewNew $ \item index -> do files <- readAttr (mpData ^. mpSongList) i <- readAttr songIndex case files ^? ix index of Just song -> do let (_, s) = separateFilePath song set item text $ Just s set item itemData $ Just index if i == index then do set item colorForeground $ mpData ^. mpColors . queueSelectedForeground set item colorStyle DrawStyleBold else do set item colorForeground $ mpData ^. mpColors . queueForeground set item colorStyle DrawStyleNormal Nothing -> do set item text Nothing set item itemData Nothing let queue = overrideWidget QueuePage { _queuePageParent = castToWidget textListView , _queuePageSongIndex = songIndex } $ virtualWidgetName .= "queuepage" set queue colorForeground $ mpData ^. mpColors . queueForeground set queue colorBackground $ mpData ^. mpColors . queueBackground set queue colorBackgroundSelected $ mpData ^. mpColors . queueActiveBackground on_ textListView textItemActivated $ \item -> do maybeIndex <- get item itemData forM_ maybeIndex (catchIgnoreAll . clientSendSetPlaying) getColors queue >>= setColors textListView on_ queue keyPressed $ \key _ -> case key of Vty.KChar 'p' -> catchIgnoreAll $ do (status, _, _) <- clientSendGetStatus case status of "Paused" -> clientSendResumePlaying "Playing" -> clientSendPausePlaying _ -> error "QueuePage.hs:105: Internal error." Vty.KChar 's' -> catchIgnoreAll clientSendStopPlaying Vty.KChar 'c' -> catchIgnoreAll $ do clientSendClear liftUIApp mpData $ readFullStatusFromServer queue Vty.KChar 'l' -> centerQueue mpData textListView Vty.KChar '>' -> do catchIgnoreAll clientSendPlayNext centerQueue mpData textListView Vty.KChar '<' -> do catchIgnoreAll clientSendPlayPrev centerQueue mpData textListView Vty.KChar 'f' -> catchIgnoreAll clientSendSeekForward Vty.KChar 'b' -> catchIgnoreAll clientSendSeekBackward Vty.KChar 'r' -> catchIgnoreAll clientSendToggleRepeat Vty.KChar 'z' -> catchIgnoreAll clientSendToggleShuffle Vty.KChar '[' -> catchIgnoreAll clientSendVolumeDown Vty.KChar ']' -> catchIgnoreAll clientSendVolumeUp Vty.KChar 'd' -> do viewIndex <- textListViewGetPos textListView when (viewIndex >= 0) $ do files <- readAttr (mpData ^. mpSongList) void $ liftUIApp mpData $ mpSongRemove (files !! viewIndex) clientSendRemove viewIndex textListViewUpdate textListView _ -> return () readFullStatusFromServer queue scheduleIndexFromServer queue return queue where readFullStatusFromServer = readFullStatusFromServer' (100 :: Int) readFullStatusFromServer' 0 _ = return () readFullStatusFromServer' counter queuePage = catchAll (do items <- clientSendGetPlaylist index <- clientSendGetPlaying set queuePage _queuePageSongIndex index mpSongInit items) (\_ -> do mpData <- view appUserData mainScheduleAfter 100 $ liftUIApp mpData $ readFullStatusFromServer' (counter - 1) queuePage) scheduleIndexFromServer queuePage = mainScheduleRepeat 200 $ catchIgnoreAll $ do index <- clientSendGetPlaying set queuePage _queuePageSongIndex index centerQueue mpData textListView = catchIgnoreAll $ do files <- readAttr (mpData ^. mpSongList) index <- clientSendGetPlaying textListViewCenterAt textListView index (length files)