{- * 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 exitUI :: IO () exitUI = clientSendSaveState >> shutdownUi makeAndRunUI :: IO () makeAndRunUI = do _ <- installHandler sigINT (Catch $ schedule exitUI) Nothing _ <- installHandler sigHUP (Catch $ schedule exitUI) Nothing _ <- installHandler sigABRT (Catch $ schedule exitUI) Nothing _ <- installHandler sigTERM (Catch $ schedule exitUI) 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' -> clientSendSaveState >> exitSuccess KASCII 'Q' -> clientSendSaveState >> 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