256 lines
7.5 KiB
Haskell
256 lines
7.5 KiB
Haskell
{- |
|
|
|
|
mtlstats
|
|
Copyright (C) Rhéal Lamothe
|
|
<rheal.lamothe@gmail.com>
|
|
|
|
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 3 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, see <https://www.gnu.org/licenses/>.
|
|
|
|
-}
|
|
|
|
module Mtlstats.Control.NewGame (newGameC) where
|
|
|
|
import Brick.Main (vScrollBy, vScrollToBeginning)
|
|
import Brick.Types
|
|
( BrickEvent (VtyEvent)
|
|
, ViewportType (Vertical)
|
|
, Widget
|
|
)
|
|
import Brick.Widgets.Center (hCenter)
|
|
import Brick.Widgets.Core (str, vBox, viewport)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.State.Class (get, gets, modify)
|
|
import Data.Maybe (fromJust, fromMaybe, isJust)
|
|
import Graphics.Vty.Input.Events
|
|
( Event (EvKey)
|
|
, Key (KDown, KHome, KEnter, KUp)
|
|
)
|
|
import Lens.Micro ((^.), (.~))
|
|
import Lens.Micro.Mtl (use)
|
|
|
|
import Mtlstats.Actions
|
|
import Mtlstats.Actions.NewGame
|
|
import Mtlstats.Config
|
|
import Mtlstats.Control.NewGame.GoalieInput
|
|
import Mtlstats.Format
|
|
import Mtlstats.Handlers
|
|
import Mtlstats.Menu
|
|
import Mtlstats.Prompt
|
|
import Mtlstats.Prompt.NewGame
|
|
import Mtlstats.Report
|
|
import Mtlstats.Types
|
|
import Mtlstats.Util
|
|
|
|
-- | Dispatcher for a new game
|
|
newGameC :: GameState -> Controller
|
|
newGameC 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
|
|
| fromJust (unaccountedPoints gs) = goalInput gs
|
|
| isJust $ gs^.gameSelectedPlayer = getPMinsC
|
|
| not $ gs^.gamePMinsRecorded = pMinPlayerC
|
|
| not $ gs^.gameGoalieAssigned = goalieInputC gs
|
|
| otherwise = reportC
|
|
|
|
gameYearC :: Controller
|
|
gameYearC = promptControllerWith header gameYearPrompt
|
|
|
|
gameMonthC :: Controller
|
|
gameMonthC = promptControllerWith monthHeader gameMonthPrompt
|
|
|
|
gameDayC :: Controller
|
|
gameDayC = promptControllerWith header gameDayPrompt
|
|
|
|
gameTypeC :: Controller
|
|
gameTypeC = menuControllerWith header gameTypeMenu
|
|
|
|
otherTeamC :: Controller
|
|
otherTeamC = promptControllerWith header otherTeamPrompt
|
|
|
|
homeScoreC :: Controller
|
|
homeScoreC = promptControllerWith header homeScorePrompt
|
|
|
|
awayScoreC :: Controller
|
|
awayScoreC = promptControllerWith header awayScorePrompt
|
|
|
|
overtimeFlagC :: Controller
|
|
overtimeFlagC = Controller
|
|
{ drawController = \s -> header s $
|
|
str "Did the game go into overtime? (Y/N)"
|
|
, handleController = \e ->
|
|
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
|
}
|
|
|
|
verifyDataC :: Controller
|
|
verifyDataC = Controller
|
|
{ drawController = \s -> let
|
|
gs = s^.progMode.gameStateL
|
|
in header s $ vBox $ map str $
|
|
[""] ++
|
|
labelTable
|
|
[ ( "Date", gameDate gs )
|
|
, ( "Game type", show $ fromJust $ gs^.gameType )
|
|
, ( "Other team", gs^.otherTeam )
|
|
, ( "Home score", show $ fromJust $ gs^.homeScore )
|
|
, ( "Away score", show $ fromJust $ gs^.awayScore )
|
|
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
|
|
] ++
|
|
[ ""
|
|
, "Is the above information correct? (Y/N)"
|
|
]
|
|
, handleController = \e ->
|
|
case ynHandler e of
|
|
Just True -> modify
|
|
$ (progMode.gameStateL.dataVerified .~ True)
|
|
. updateGameStats
|
|
. awardShutouts
|
|
Just False -> modify $ progMode.gameStateL .~ newGameState
|
|
Nothing -> return ()
|
|
}
|
|
|
|
goalInput :: GameState -> Controller
|
|
goalInput gs
|
|
| null (gs^.goalBy ) = recordGoalC
|
|
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
|
| otherwise = confirmGoalDataC
|
|
|
|
recordGoalC :: Controller
|
|
recordGoalC = Controller
|
|
{ drawController = \s -> let
|
|
(game, goal) = gameGoal s
|
|
in drawPrompt (recordGoalPrompt game goal) s
|
|
, handleController = \e -> do
|
|
(game, goal) <- gets gameGoal
|
|
promptHandler (recordGoalPrompt game goal) e
|
|
}
|
|
|
|
recordAssistC :: Controller
|
|
recordAssistC = Controller
|
|
{ drawController = \s -> let
|
|
(game, goal, assist) = gameGoalAssist s
|
|
in drawPrompt (recordAssistPrompt game goal assist) s
|
|
, handleController = \e -> do
|
|
(game, goal, assist) <- gets gameGoalAssist
|
|
promptHandler (recordAssistPrompt game goal assist) e
|
|
}
|
|
|
|
confirmGoalDataC :: Controller
|
|
confirmGoalDataC = Controller
|
|
{ drawController = \s -> let
|
|
(game, goal) = gameGoal s
|
|
gs = s^.progMode.gameStateL
|
|
players = s^.database.dbPlayers
|
|
msg =
|
|
[ " Game: " ++ padNum 2 game
|
|
, " Goal: " ++ show goal
|
|
, "Goal scored by: " ++
|
|
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
|
] ++
|
|
map
|
|
( \pid -> " Assisted by: " ++
|
|
playerSummary (fromJust $ nth pid players)
|
|
)
|
|
(gs^.assistsBy) ++
|
|
[ ""
|
|
, "Is the above information correct? (Y/N)"
|
|
]
|
|
in vBox $ map str msg
|
|
, handleController = \e -> do
|
|
case ynHandler e of
|
|
Just True -> modify recordGoalAssists
|
|
Just False -> modify resetGoalData
|
|
Nothing -> return ()
|
|
}
|
|
|
|
pMinPlayerC :: Controller
|
|
pMinPlayerC = Controller
|
|
{ drawController = \s -> header s $
|
|
drawPrompt pMinPlayerPrompt s
|
|
, handleController = promptHandler pMinPlayerPrompt
|
|
}
|
|
|
|
getPMinsC :: Controller
|
|
getPMinsC = Controller
|
|
{ drawController = \s -> header s $ vBox
|
|
[ str $ fromMaybe "" $ do
|
|
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
|
player <- nth pid $ s^.database.dbPlayers
|
|
Just $ playerSummary player
|
|
, drawPrompt assignPMinsPrompt s
|
|
]
|
|
, handleController = promptHandler assignPMinsPrompt
|
|
}
|
|
|
|
reportC :: Controller
|
|
reportC = Controller
|
|
{ drawController = viewport () Vertical . hCenter . vBox . map str .
|
|
displayReport reportCols
|
|
, handleController = \e -> do
|
|
scr <- use scroller
|
|
case e of
|
|
VtyEvent (EvKey k []) -> case k of
|
|
KUp -> vScrollBy scr (-1)
|
|
KDown -> vScrollBy scr 1
|
|
KHome -> vScrollToBeginning scr
|
|
KEnter -> do
|
|
get >>= liftIO . writeFile reportFilename . exportReport reportCols
|
|
modify backHome
|
|
_ -> return ()
|
|
_ -> return ()
|
|
}
|
|
|
|
header :: ProgState -> Widget () -> Widget ()
|
|
header s w = vBox
|
|
[ str $ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
|
, w
|
|
]
|
|
|
|
monthHeader :: ProgState -> Widget () -> Widget ()
|
|
monthHeader s w = let
|
|
table = labelTable $ zip (map show ([1..] :: [Int]))
|
|
[ "JANUARY"
|
|
, "FEBRUARY"
|
|
, "MARCH"
|
|
, "APRIL"
|
|
, "MAY"
|
|
, "JUNE"
|
|
, "JULY"
|
|
, "AUGUST"
|
|
, "SEPTEMBER"
|
|
, "OCTOBER"
|
|
, "NOVEMBER"
|
|
, "DECEMBER"
|
|
]
|
|
in header s $ vBox $ map (hCenter . str)
|
|
(["MONTH:", ""] ++ table ++ [""]) ++ [w]
|
|
|
|
gameGoal :: ProgState -> (Int, Int)
|
|
gameGoal s =
|
|
( s^.database.dbGames
|
|
, succ $ s^.progMode.gameStateL.pointsAccounted
|
|
)
|
|
|
|
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
|
gameGoalAssist s = let
|
|
(game, goal) = gameGoal s
|
|
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
|
in (game, goal, assist)
|