prompt for confirmation of game input
This commit is contained in:
Jonathan Lamothe
parent
27867ba69d
commit
dc2f632563
|
|
@ -24,11 +24,13 @@ module Mtlstats.Control (dispatch) where
|
|||
import Control.Monad (when)
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Data.Char (toUpper)
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (.~))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Report
|
||||
|
|
@ -38,121 +40,157 @@ import Mtlstats.Types
|
|||
-- run
|
||||
dispatch :: ProgState -> Controller
|
||||
dispatch s = case s^.progMode of
|
||||
|
||||
MainMenu -> Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
|
||||
NewSeason -> Controller
|
||||
{ drawController = const $ drawMenu newSeasonMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler newSeasonMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
MainMenu -> mainMenuC
|
||||
NewSeason -> newSeasonC
|
||||
NewGame gs
|
||||
| null $ gs^.gameYear -> gameYearC
|
||||
| null $ gs^.gameMonth -> gameMonthC
|
||||
| null $ gs^.gameDay -> gameDayC
|
||||
| null $ gs^.gameType -> gameTypeC
|
||||
| null $ gs^.otherTeam -> otherTeamC
|
||||
| null $ gs^.homeScore -> homeScoreC
|
||||
| null $ gs^.awayScore -> awayScoreC
|
||||
| null $ gs^.overtimeFlag -> overtimeFlagC
|
||||
| not $ gs^.dataVerified -> verifyDataC
|
||||
| otherwise -> reportC
|
||||
|
||||
| null $ gs^.gameYear -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameYearPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameYearPrompt e
|
||||
return True
|
||||
}
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
|
||||
| null $ gs^.gameMonth -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameMonthMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameMonthMenu e
|
||||
return True
|
||||
}
|
||||
newSeasonC :: Controller
|
||||
newSeasonC = Controller
|
||||
{ drawController = const $ drawMenu newSeasonMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler newSeasonMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.gameDay -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameDayPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameDayPrompt e
|
||||
modify validateGameDate
|
||||
return True
|
||||
}
|
||||
gameYearC :: Controller
|
||||
gameYearC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameYearPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameYearPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.gameType -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameTypeMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameTypeMenu e
|
||||
return True
|
||||
}
|
||||
gameMonthC :: Controller
|
||||
gameMonthC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameMonthMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameMonthMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.otherTeam -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt otherTeamPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler otherTeamPrompt e
|
||||
return True
|
||||
}
|
||||
gameDayC :: Controller
|
||||
gameDayC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameDayPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameDayPrompt e
|
||||
modify validateGameDate
|
||||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.homeScore -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt homeScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler homeScorePrompt e
|
||||
return True
|
||||
}
|
||||
gameTypeC :: Controller
|
||||
gameTypeC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameTypeMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameTypeMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.awayScore -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt awayScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler awayScorePrompt e
|
||||
modify overtimeCheck
|
||||
otherTeamC :: Controller
|
||||
otherTeamC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt otherTeamPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler otherTeamPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
homeScoreC :: Controller
|
||||
homeScoreC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt homeScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler homeScorePrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
awayScoreC :: Controller
|
||||
awayScoreC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt awayScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler awayScorePrompt e
|
||||
modify overtimeCheck
|
||||
return True
|
||||
}
|
||||
|
||||
overtimeFlagC :: Controller
|
||||
overtimeFlagC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString "Did the game go into overtime? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||
return True
|
||||
}
|
||||
|
||||
verifyDataC :: Controller
|
||||
verifyDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let gs = s^.progMode.gameStateL
|
||||
header s
|
||||
C.drawString "\n"
|
||||
C.drawString $ " Date: " ++ date gs ++ "\n"
|
||||
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
|
||||
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
|
||||
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
|
||||
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
|
||||
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
|
||||
C.drawString "Is the above information correct? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> do
|
||||
modify $ progMode.gameStateL.dataVerified .~ True
|
||||
modify updateGameStats
|
||||
return True
|
||||
}
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
| null $ gs^.overtimeFlag -> Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString "Did the game go into overtime? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
overtimePrompt e
|
||||
modify updateGameStats
|
||||
return True
|
||||
}
|
||||
|
||||
| otherwise -> Controller
|
||||
{ drawController = \s -> do
|
||||
(_, cols) <- C.windowSize
|
||||
C.drawString $ report (fromInteger $ pred cols) s
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
when
|
||||
(case e of
|
||||
C.EventCharacter _ -> True
|
||||
C.EventSpecialKey _ -> True
|
||||
_ -> False) $
|
||||
modify $ progMode .~ MainMenu
|
||||
return True
|
||||
}
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(_, cols) <- C.windowSize
|
||||
C.drawString $ report (fromInteger $ pred cols) s
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
when
|
||||
(case e of
|
||||
C.EventCharacter _ -> True
|
||||
C.EventSpecialKey _ -> True
|
||||
_ -> False) $
|
||||
modify $ progMode .~ MainMenu
|
||||
return True
|
||||
}
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $
|
||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||
|
||||
overtimePrompt :: C.Event -> Action ()
|
||||
overtimePrompt (C.EventCharacter c) = modify $
|
||||
progMode.gameStateL.overtimeFlag .~ case toUpper c of
|
||||
'Y' -> Just True
|
||||
'N' -> Just False
|
||||
_ -> Nothing
|
||||
overtimePrompt _ = return ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user