{-# LANGUAGE OverloadedStrings #-} module AskScene where import Graphics.Vty.Widgets.All import Graphics.Vty.Input.Events 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 "Cancel" 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)