mtlstats/src/Mtlstats/Prompt.hs

269 lines
7.9 KiB
Haskell
Raw Normal View History

2019-08-24 16:23:56 -04:00
{- |
mtlstats
Copyright (C) 2019 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/>.
-}
2019-09-19 04:35:01 -04:00
{-# LANGUAGE LambdaCase #-}
2019-08-24 16:23:56 -04:00
module Mtlstats.Prompt (
-- * Prompt Functions
drawPrompt,
promptHandler,
2019-08-24 21:15:50 -04:00
strPrompt,
2019-08-24 19:02:29 -04:00
numPrompt,
-- * Individual prompts
2019-08-31 11:28:09 -04:00
gameYearPrompt,
gameDayPrompt,
2019-08-25 10:04:37 -04:00
otherTeamPrompt,
2019-08-24 20:14:49 -04:00
homeScorePrompt,
2019-09-09 13:04:39 -04:00
awayScorePrompt,
2019-09-09 22:50:44 -04:00
playerNumPrompt,
playerNamePrompt,
2019-09-19 04:35:01 -04:00
playerPosPrompt,
selectPlayerPrompt,
2019-09-19 05:50:48 -04:00
recordGoalPrompt,
2019-10-09 01:24:55 -04:00
recordAssistPrompt,
2019-10-09 22:15:40 -04:00
pMinPlayerPrompt,
2019-10-24 15:53:24 -04:00
assignPMinsPrompt,
2019-10-25 00:45:39 -04:00
goalieNumPrompt,
goalieNamePrompt,
selectGameGoaliePrompt
2019-08-24 16:23:56 -04:00
) where
import Control.Monad (when)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (isDigit, toUpper)
import Data.Foldable (forM_)
2019-09-19 05:50:48 -04:00
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
2019-08-24 16:23:56 -04:00
import Lens.Micro.Extras (view)
import Text.Read (readMaybe)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Config
2019-09-19 05:50:48 -04:00
import Mtlstats.Format
2019-08-24 16:23:56 -04:00
import Mtlstats.Types
2019-09-19 04:35:01 -04:00
import Mtlstats.Util
2019-08-24 16:23:56 -04:00
-- | Draws the prompt to the screen
drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
drawPrompt p s = do
promptDrawer p s
return C.CursorVisible
-- | Event handler for a prompt
promptHandler :: Prompt -> C.Event -> Action ()
promptHandler p (C.EventCharacter '\n') = do
val <- gets $ view inputBuffer
modify $ inputBuffer .~ ""
promptAction p val
promptHandler p (C.EventCharacter c) = let
c' = toUpper c
in when (promptCharCheck p c') $
modify $ addChar c'
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
modify removeChar
promptHandler p (C.EventSpecialKey k) =
promptSpecialKey p k
2019-08-24 16:23:56 -04:00
promptHandler _ _ = return ()
2019-08-24 21:15:50 -04:00
-- | Builds a string prompt
strPrompt
:: String
-- ^ The prompt string
-> (String -> Action ())
-- ^ The callback function for the result
-> Prompt
strPrompt pStr act = Prompt
{ promptDrawer = drawSimplePrompt pStr
, promptCharCheck = const True
, promptAction = act
, promptSpecialKey = const $ return ()
2019-08-24 21:15:50 -04:00
}
2019-08-24 16:23:56 -04:00
-- | Builds a numeric prompt
numPrompt
:: String
-- ^ The prompt string
-> (Int -> Action ())
-- ^ The callback function for the result
-> Prompt
numPrompt pStr act = Prompt
{ promptDrawer = drawSimplePrompt pStr
, promptCharCheck = isDigit
, promptAction = \inStr -> forM_ (readMaybe inStr) act
, promptSpecialKey = const $ return ()
2019-08-24 16:23:56 -04:00
}
2019-08-24 19:02:29 -04:00
2019-08-31 11:28:09 -04:00
-- | Prompts for the game year
gameYearPrompt :: Prompt
gameYearPrompt = numPrompt "Game year: " $
modify . (progMode.gameStateL.gameYear ?~)
-- | Prompts for the day of the month the game took place
gameDayPrompt :: Prompt
gameDayPrompt = numPrompt "Day of month: " $
modify . (progMode.gameStateL.gameDay ?~)
2019-08-31 11:24:55 -04:00
-- | Prompts for the other team name
2019-08-25 10:04:37 -04:00
otherTeamPrompt :: Prompt
otherTeamPrompt = strPrompt "Other team: " $
2019-08-31 11:27:02 -04:00
modify . (progMode.gameStateL.otherTeam .~)
2019-08-25 10:04:37 -04:00
2019-08-31 11:24:55 -04:00
-- | Prompts for the home score
2019-08-24 19:02:29 -04:00
homeScorePrompt :: Prompt
homeScorePrompt = numPrompt "Home score: " $
2019-08-31 11:27:02 -04:00
modify . (progMode.gameStateL.homeScore ?~)
2019-08-24 20:14:49 -04:00
2019-08-31 11:24:55 -04:00
-- | Prompts for the away score
2019-08-24 20:14:49 -04:00
awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $
2019-08-31 11:27:02 -04:00
modify . (progMode.gameStateL.awayScore ?~)
2019-08-24 21:15:50 -04:00
2019-09-09 13:04:39 -04:00
-- | Prompts for a new player's number
playerNumPrompt :: Prompt
playerNumPrompt = numPrompt "Player number: " $
modify . (progMode.createPlayerStateL.cpsNumber ?~)
2019-09-09 22:50:44 -04:00
-- | Prompts for a new player's name
playerNamePrompt :: Prompt
playerNamePrompt = strPrompt "Player name: " $
modify . (progMode.createPlayerStateL.cpsName .~)
2019-09-09 22:57:36 -04:00
-- | Prompts for a new player's position
playerPosPrompt :: Prompt
playerPosPrompt = strPrompt "Player position: " $
modify . (progMode.createPlayerStateL.cpsPosition .~)
2019-09-19 04:35:01 -04:00
-- | Selects a player (creating one if necessary)
selectPlayerPrompt
:: String
-- ^ The prompt string
-> (Maybe Int -> Action ())
-- ^ The callback to run (takes the index number of the payer as
-- input)
-> Prompt
selectPlayerPrompt pStr callback = Prompt
{ promptDrawer = \s -> do
let sStr = s^.inputBuffer
C.drawString pStr
C.drawString sStr
(row, col) <- C.cursorPosition
C.drawString "\n\nPlayer select:\n"
let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
2019-09-19 04:35:01 -04:00
mapM_
(\(n, (_, p)) -> C.drawString $
"F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
sel
C.moveCursor row col
, promptCharCheck = const True
, promptAction = \sStr -> if null sStr
then callback Nothing
else do
players <- gets $ view $ database.dbPlayers
case playerSearchExact sStr players of
Just (n, _) -> callback $ Just n
Nothing -> do
mode <- gets $ view progMode
let
cps = newCreatePlayerState
& cpsName .~ sStr
& cpsSuccessCallback .~ do
modify $ progMode .~ mode
pIndex <- pred . length <$> gets (view $ database.dbPlayers)
callback $ Just pIndex
& cpsFailureCallback .~ do
modify $ progMode .~ mode
modify $ progMode .~ CreatePlayer cps
2019-09-19 04:35:01 -04:00
, promptSpecialKey = \case
C.KeyFunction n -> do
sStr <- gets $ view inputBuffer
players <- gets $ view $ database.dbPlayers
modify $ inputBuffer .~ ""
2019-09-19 04:35:01 -04:00
let
fKey = pred $ fromIntegral n
options = playerSearch sStr players
sel = fst <$> nth fKey options
callback sel
_ -> return ()
}
2019-09-19 05:50:48 -04:00
-- | Prompts for the player who scored the goal
recordGoalPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal number
-> Prompt
recordGoalPrompt game goal = selectPlayerPrompt
2019-09-26 01:23:34 -04:00
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Who scored goal number " ++ show goal ++ "? "
) $ modify . (progMode.gameStateL.goalBy .~)
2019-09-19 05:50:48 -04:00
2019-09-26 01:23:34 -04:00
-- | Prompts for a player who assisted the goal
recordAssistPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal nuber
-> Int
-- ^ The assist number
-> Prompt
recordAssistPrompt game goal assist = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Goal: " ++ show goal ++ "\n"
++ "Assist #" ++ show assist ++ ": "
) $ \case
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
Just n -> do
modify $ progMode.gameStateL.assistsBy %~ (++[n])
nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
when (nAssists >= maxAssists) $
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
2019-09-26 01:23:34 -04:00
2019-10-25 00:48:28 -04:00
-- | Prompts for the player to assign penalty minutes to
2019-10-09 01:24:55 -04:00
pMinPlayerPrompt :: Prompt
2019-10-09 21:54:55 -04:00
pMinPlayerPrompt = selectPlayerPrompt
"Assign penalty minutes to: " $
\case
Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True
Just n -> modify $ progMode.gameStateL.selectedPlayer ?~ n
2019-10-09 01:24:55 -04:00
2019-10-25 00:48:28 -04:00
-- | Prompts for the number of penalty mintues to assign to the player
2019-10-09 22:15:40 -04:00
assignPMinsPrompt :: Prompt
2019-10-09 22:32:14 -04:00
assignPMinsPrompt = numPrompt "Penalty minutes: " $
modify . assignPMins
2019-10-09 22:15:40 -04:00
2019-10-25 00:48:28 -04:00
-- | Prompts tor the goalie's number
2019-10-24 15:53:24 -04:00
goalieNumPrompt :: Prompt
2019-10-25 00:11:26 -04:00
goalieNumPrompt = numPrompt "Goalie number: " $
modify . (progMode.createGoalieStateL.cgsNumber ?~)
2019-10-24 15:53:24 -04:00
2019-10-25 00:48:28 -04:00
-- | Prompts for the goalie's name
2019-10-25 00:45:39 -04:00
goalieNamePrompt :: Prompt
goalieNamePrompt = strPrompt "Goalie name: " $
modify . (progMode.createGoalieStateL.cgsName .~)
-- | Prompts for a goalie who played in the game
selectGameGoaliePrompt :: Prompt
selectGameGoaliePrompt = undefined
2019-08-24 21:15:50 -04:00
drawSimplePrompt :: String -> ProgState -> C.Update ()
2019-08-31 11:27:02 -04:00
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer