wip: switching from ncurses to brick
This commit is contained in:
@@ -21,11 +21,23 @@ 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.Trans.State (get, gets, modify)
|
||||
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 qualified UI.NCurses as C
|
||||
import Lens.Micro.Mtl (use)
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Actions.NewGame
|
||||
@@ -81,32 +93,30 @@ awayScoreC = promptControllerWith header awayScorePrompt
|
||||
|
||||
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
|
||||
{ drawController = \s -> header s $
|
||||
str "Did the game go into overtime? (Y/N)"
|
||||
, handleController = \e ->
|
||||
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 $ unlines $ labelTable
|
||||
{ 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 )
|
||||
]
|
||||
C.drawString "\nIs the above information correct? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
] ++
|
||||
[ ""
|
||||
, "Is the above information correct? (Y/N)"
|
||||
]
|
||||
, handleController = \e ->
|
||||
case ynHandler e of
|
||||
Just True -> modify
|
||||
$ (progMode.gameStateL.dataVerified .~ True)
|
||||
@@ -114,7 +124,6 @@ verifyDataC = Controller
|
||||
. awardShutouts
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
goalInput :: GameState -> Controller
|
||||
@@ -131,7 +140,6 @@ recordGoalC = Controller
|
||||
, handleController = \e -> do
|
||||
(game, goal) <- gets gameGoal
|
||||
promptHandler (recordGoalPrompt game goal) e
|
||||
return True
|
||||
}
|
||||
|
||||
recordAssistC :: Controller
|
||||
@@ -142,114 +150,97 @@ recordAssistC = Controller
|
||||
, handleController = \e -> do
|
||||
(game, goal, assist) <- gets gameGoalAssist
|
||||
promptHandler (recordAssistPrompt game goal assist) e
|
||||
return True
|
||||
}
|
||||
|
||||
confirmGoalDataC :: Controller
|
||||
confirmGoalDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
(game, goal) = gameGoal s
|
||||
gs = s^.progMode.gameStateL
|
||||
players = s^.database.dbPlayers
|
||||
msg = unlines $
|
||||
[ " 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)"
|
||||
]
|
||||
C.drawString msg
|
||||
return C.CursorInvisible
|
||||
{ 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 ()
|
||||
return True
|
||||
}
|
||||
|
||||
pMinPlayerC :: Controller
|
||||
pMinPlayerC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
{ drawController = \s -> header s $
|
||||
drawPrompt pMinPlayerPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler pMinPlayerPrompt e
|
||||
return True
|
||||
, handleController = promptHandler pMinPlayerPrompt
|
||||
}
|
||||
|
||||
getPMinsC :: Controller
|
||||
getPMinsC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString $ fromMaybe "" $ do
|
||||
{ drawController = \s -> header s $ vBox
|
||||
[ str $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerSummary player ++ "\n"
|
||||
drawPrompt assignPMinsPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler assignPMinsPrompt e
|
||||
return True
|
||||
Just $ playerSummary player
|
||||
, drawPrompt assignPMinsPrompt s
|
||||
]
|
||||
, handleController = promptHandler assignPMinsPrompt
|
||||
}
|
||||
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(rows, cols) <- C.windowSize
|
||||
C.drawString $ unlines $ slice
|
||||
(s^.scrollOffset)
|
||||
(fromInteger $ pred rows)
|
||||
(displayReport (fromInteger $ pred cols) s)
|
||||
return C.CursorInvisible
|
||||
{ drawController = viewport () Vertical . hCenter . vBox . map str .
|
||||
displayReport reportCols
|
||||
, handleController = \e -> do
|
||||
scr <- use scroller
|
||||
case e of
|
||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||
|
||||
C.EventCharacter '\n' -> do
|
||||
get >>= liftIO . writeFile reportFilename . exportReport reportCols
|
||||
modify backHome
|
||||
|
||||
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 ()
|
||||
return True
|
||||
}
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $
|
||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||
header :: ProgState -> Widget () -> Widget ()
|
||||
header s w = vBox
|
||||
[ str $ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||
, w
|
||||
]
|
||||
|
||||
monthHeader :: ProgState -> C.Update ()
|
||||
monthHeader s = do
|
||||
(_, cols) <- C.windowSize
|
||||
header s
|
||||
|
||||
let
|
||||
table = labelTable $ zip (map show ([1..] :: [Int]))
|
||||
[ "JANUARY"
|
||||
, "FEBRUARY"
|
||||
, "MARCH"
|
||||
, "APRIL"
|
||||
, "MAY"
|
||||
, "JUNE"
|
||||
, "JULY"
|
||||
, "AUGUST"
|
||||
, "SEPTEMBER"
|
||||
, "OCTOBER"
|
||||
, "NOVEMBER"
|
||||
, "DECEMBER"
|
||||
]
|
||||
|
||||
C.drawString $ unlines $
|
||||
map (centre $ fromIntegral $ pred cols) $
|
||||
["MONTH:", ""] ++ table ++ [""]
|
||||
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 =
|
||||
|
||||
Reference in New Issue
Block a user