Main.hs

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