HelpPage.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
-}

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   " "