pgdl-7.4: src/AskScene.hs

{-# LANGUAGE OverloadedStrings #-}

module AskScene where

import Graphics.Vty.Widgets.All
import Graphics.Vty.Input.Events

import qualified Data.Text as T
import Control.Monad

data AskScene = AskScene { sceneWidget :: Widget (Bordered Padded)
                         , playHand :: Handlers AskScene
                         , downHand :: Handlers AskScene
                         , quitHand :: Handlers AskScene
                         , remvHand :: Handlers AskScene
                         }

newAskScene :: IO (AskScene, Widget FocusGroup)
newAskScene = do
    playB <- newButton "No"
    downB <- newButton "Yes"
    quitB <- newButton "Quit"
    remvB <- newButton "Remov"
    buttonBox <- (mkwIO playB) <++> (mkwIO downB) <++> (mkwIO quitB) <++> (mkwIO remvB)
    b <- do
        bx <- (plainText "    Download it again?") <--> (return buttonBox)
        setBoxSpacing bx 1
        withPadding (padAll 1) bx
    fg <- newFocusGroup
    mapM_ (addToFocusGroup fg . buttonWidget) [playB, downB, quitB, remvB]
    ui <- withBorderedLabel "File Exists!" =<< bordered b
    [phs, dhs, qhs, rhs] <- replicateM 4 newHandlers
    let sce = AskScene { sceneWidget = ui
                       , playHand = phs
                       , downHand = dhs
                       , quitHand = qhs
                       , remvHand = rhs
                       }
    onButtonPressed playB $ \_ -> 
        fireEvent sce (return . playHand) sce
    onButtonPressed downB $ \_ -> 
        fireEvent sce (return . downHand) sce
    onButtonPressed quitB $ \_ -> 
        fireEvent sce (return . quitHand) sce
    onButtonPressed remvB $ \_ ->
        fireEvent sce (return . remvHand) sce
    setFocusGroupNextKey fg KRight []
    setFocusGroupPrevKey fg KLeft []
    return (sce, fg)
    where mkwIO = return . buttonWidget

onScePlay :: AskScene -> Handler AskScene -> IO ()
onScePlay = addHandler (return . playHand)

onSceDown :: AskScene -> Handler AskScene -> IO ()
onSceDown = addHandler (return . downHand)

onSceQuit :: AskScene -> Handler AskScene -> IO ()
onSceQuit = addHandler (return . quitHand)

onSceRemv :: AskScene -> Handler AskScene -> IO()
onSceRemv = addHandler (return . remvHand)