fingerprint/mtlstats
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge pull request #66 from mtlstats/master-menu 

Master menu
This commit is contained in:
Jonathan Lamothe 2020-01-22 21:53:09 -05:00 committed by GitHub
parent 4c7a756c5e de56f4f94d
commit 7fbeaac933
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 114 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ChangeLog.md
View File

@ -6,6 +6,7 @@
- Save a copy of the database on new season - Save a copy of the database on new season
- Implemented game standings editing - Implemented game standings editing
- Added title screen - Added title screen
- Changed sytling of menus
## 0.10.0 ## 0.10.0
- Don't show player number zero in reports - Don't show player number zero in reports

69
src/Mtlstats/Menu.hs
View File

@ -46,6 +46,7 @@ import Mtlstats.Actions
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
import Mtlstats.Actions.EditStandings import Mtlstats.Actions.EditStandings
import Mtlstats.Config import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Types.Menu import Mtlstats.Types.Menu
import Mtlstats.Util import Mtlstats.Util
@ -89,7 +90,11 @@ menuStateController menuFunc = Controller
-- | The draw function for a 'Menu' -- | The draw function for a 'Menu'
drawMenu :: Menu a -> C.Update C.CursorMode drawMenu :: Menu a -> C.Update C.CursorMode
drawMenu m = do drawMenu m = do
C.drawString $ show m (_, cols) <- C.windowSize
let
width = fromIntegral $ pred cols
menuText = map (centre width) $ lines $ show m
C.drawString $ unlines menuText
return C.CursorInvisible return C.CursorInvisible
-- | The event handler for a 'Menu' -- | The event handler for a 'Menu'
@ -102,56 +107,56 @@ menuHandler m _ = return $ m^.menuDefault
-- | The main menu -- | The main menu
mainMenu :: Menu Bool mainMenu :: Menu Bool
mainMenu = Menu "*** MAIN MENU ***" True mainMenu = Menu "MASTER MENU" True
[ MenuItem '1' "New Season" $ [ MenuItem 'A' "NEW SEASON" $
modify startNewSeason >> return True modify startNewSeason >> return True
, MenuItem '2' "New Game" $ , MenuItem 'B' "NEW GAME" $
modify startNewGame >> return True modify startNewGame >> return True
, MenuItem '3' "Edit" $ , MenuItem 'C' "EDIT MENU" $
modify edit >> return True modify edit >> return True
, MenuItem 'X' "Exit" $ , MenuItem 'E' "EXIT" $
saveDatabase dbFname >> return False saveDatabase dbFname >> return False
] ]
-- | The new season menu -- | The new season menu
newSeasonMenu :: Menu () newSeasonMenu :: Menu ()
newSeasonMenu = Menu "*** SEASON TYPE ***" () newSeasonMenu = Menu "SEASON TYPE" ()
[ MenuItem 'R' "Regular Season" $ modify [ MenuItem 'R' "REGULAR SEASON" $ modify
$ resetYtd $ resetYtd
. clearRookies . clearRookies
. resetStandings . resetStandings
. startNewGame . startNewGame
, MenuItem 'P' "Playoffs" $ modify , MenuItem 'P' "PLAYOFFS" $ modify
$ resetStandings $ resetStandings
. startNewGame . startNewGame
] ]
-- | Requests the month in which the game took place -- | Requests the month in which the game took place
gameMonthMenu :: Menu () gameMonthMenu :: Menu ()
gameMonthMenu = Menu "Month:" () $ map gameMonthMenu = Menu "MONTH:" () $ map
(\(ch, name, val) -> (\(ch, name, val) ->
MenuItem ch name $ MenuItem ch name $
modify $ progMode.gameStateL.gameMonth ?~ val) modify $ progMode.gameStateL.gameMonth ?~ val)
[ ( 'A', "January", 1 ) [ ( 'A', "JANUARY", 1 )
, ( 'B', "February", 2 ) , ( 'B', "FEBRUARY", 2 )
, ( 'C', "March", 3 ) , ( 'C', "MARCH", 3 )
, ( 'D', "April", 4 ) , ( 'D', "APRIL", 4 )
, ( 'E', "May", 5 ) , ( 'E', "MAY", 5 )
, ( 'F', "June", 6 ) , ( 'F', "JUNE", 6 )
, ( 'G', "July", 7 ) , ( 'G', "JULY", 7 )
, ( 'H', "August", 8 ) , ( 'H', "AUGUST", 8 )
, ( 'I', "September", 9 ) , ( 'I', "SEPTEMBER", 9 )
, ( 'J', "October", 10 ) , ( 'J', "OCTOBER", 10 )
, ( 'K', "November", 11 ) , ( 'K', "NOVEMBER", 11 )
, ( 'L', "December", 12 ) , ( 'L', "DECEMBER", 12 )
] ]
-- | The game type menu (home/away) -- | The game type menu (home/away)
gameTypeMenu :: Menu () gameTypeMenu :: Menu ()
gameTypeMenu = Menu "Game type:" () gameTypeMenu = Menu "GAME TYPE:" ()
[ MenuItem '1' "Home Game" $ [ MenuItem 'H' "HOME GAME" $
modify $ progMode.gameStateL.gameType ?~ HomeGame modify $ progMode.gameStateL.gameType ?~ HomeGame
, MenuItem '2' "Away Game" $ , MenuItem 'A' "AWAY GAME" $
modify $ progMode.gameStateL.gameType ?~ AwayGame modify $ progMode.gameStateL.gameType ?~ AwayGame
] ]
@ -172,17 +177,17 @@ gameGoalieMenu s = let
-- | The edit menu -- | The edit menu
editMenu :: Menu () editMenu :: Menu ()
editMenu = Menu "*** EDIT ***" () editMenu = Menu "EDIT MENU" ()
[ MenuItem '1' "Create Player" $ [ MenuItem 'A' "CREATE PLAYER" $
modify createPlayer modify createPlayer
, MenuItem '2' "Create Goalie" $ , MenuItem 'B' "CREATE GOALIE" $
modify createGoalie modify createGoalie
, MenuItem '3' "Edit Player" $ , MenuItem 'C' "EDIT PLAYER" $
modify editPlayer modify editPlayer
, MenuItem '4' "Edit Goalie" $ , MenuItem 'D' "EDIT GOALIE" $
modify editGoalie modify editGoalie
, MenuItem '5' "Edit Standings" $ , MenuItem 'E' "EDIT STANDINGS" $
modify editStandings modify editStandings
, MenuItem 'R' "Return to Main Menu" $ , MenuItem 'R' "RETURN TO MAIN MENU" $
modify backHome modify backHome
] ]

56
src/Mtlstats/Menu/EditGoalie.hs
View File

@ -34,17 +34,17 @@ import Mtlstats.Types.Menu
-- | The 'Goalie' edit menu -- | The 'Goalie' edit menu
editGoalieMenu :: Menu () editGoalieMenu :: Menu ()
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
(\(ch, label, action) -> MenuItem ch label $ modify action) (\(ch, label, action) -> MenuItem ch label $ modify action)
-- key, label, value -- key, label, value
[ ( '1', "Edit number", set EGNumber ) [ ( 'A', "EDIT NUMBER", set EGNumber )
, ( '2', "Edit name", set EGName ) , ( 'B', "EDIT NAME", set EGName )
, ( '3', "Toggle rookie flag", toggleRookie ) , ( 'C', "TOGGLE ROOKIE FLAG", toggleRookie )
, ( '4', "Toggle active flag", toggleActive ) , ( 'D', "TOGGLE ACTIVE FLAG", toggleActive )
, ( '5', "Edit YTD stats", set EGYtd ) , ( 'E', "EDIT YTD STATS", set EGYtd )
, ( '6', "Edit Lifetime stats", set EGLifetime ) , ( 'F', "EDIT LIFETIME STATS", set EGLifetime )
, ( 'R', "Return to Edit Menu", edit ) , ( 'R', "RETURN TO EDIT MENU", edit )
] ]
where where
@ -54,33 +54,33 @@ editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
-- | The 'Goalie' YTD edit menu -- | The 'Goalie' YTD edit menu
editGoalieYtdMenu :: Menu () editGoalieYtdMenu :: Menu ()
editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***" editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
-- key, label, value -- key, label, value
[ ( '1', "Edit all YTD stats", EGYtdGames True ) [ ( 'A', "EDIT ALL YTD STATS", EGYtdGames True )
, ( '2', "Edit YTD games", EGYtdGames False ) , ( 'B', "EDIT YTD GAMES", EGYtdGames False )
, ( '3', "Edit YTD minutes", EGYtdMins False ) , ( 'C', "EDIT YTD MINUTES", EGYtdMins False )
, ( '4', "Edit YTD goals", EGYtdGoals False ) , ( 'D', "EDIT YTD GOALS", EGYtdGoals False )
, ( '5', "Edit YTD shutouts", EGYtdShutouts False ) , ( 'E', "EDIT YTD SHUTOUTS", EGYtdShutouts False )
, ( '6', "Edit YTD wins", EGYtdWins False ) , ( 'F', "EDIT YTD WINS", EGYtdWins False )
, ( '7', "Edit YTD losses", EGYtdLosses False ) , ( 'G', "EDIT YTD LOSSES", EGYtdLosses False )
, ( '8', "Edit YTD ties", EGYtdTies ) , ( 'H', "EDIT YTD TIES", EGYtdTies )
, ( 'R', "Return to edit menu", EGMenu ) , ( 'R', "RETURN TO EDIT MENU", EGMenu )
] ]
-- | The 'Goalie' lifetime edit menu -- | The 'Goalie' lifetime edit menu
editGoalieLtMenu :: Menu () editGoalieLtMenu :: Menu ()
editGoalieLtMenu = editMenu editGoalieLtMenu = editMenu
"*** EDIT GOALTENDER LIFETIME ***" "EDIT GOALTENDER LIFETIME"
-- key, label, value -- key, label, value
[ ( '1', "Edit all lifetime stats", EGLtGames True ) [ ( 'A', "EDIT ALL LIFETIME STATS", EGLtGames True )
, ( '2', "Edit lifetime games", EGLtGames False ) , ( 'B', "EDIT LIFETIME GAMES", EGLtGames False )
, ( '3', "Edit lifetime minutes", EGLtMins False ) , ( 'C', "EDIT LIFETIME MINUTES", EGLtMins False )
, ( '4', "Edit lifetime goals", EGLtGoals False ) , ( 'D', "EDIT LIFETIME GOALS", EGLtGoals False )
, ( '5', "Edit lifetime shutouts", EGLtShutouts False ) , ( 'E', "EDIT LIFETIME SHUTOUTS", EGLtShutouts False )
, ( '6', "Edit lifetime wins", EGLtWins False ) , ( 'F', "EDIT LIFETIME WINS", EGLtWins False )
, ( '7', "Edit lifetime losses", EGLtLosses False ) , ( 'G', "EDIT LIFETIME LOSSES", EGLtLosses False )
, ( '8', "Edit lifetime ties", EGLtTies ) , ( 'H', "EDIT LIFETIME TIES", EGLtTies )
, ( 'R', "Return to edit menu", EGMenu ) , ( 'R', "RETURN TO EDIT MENU", EGMenu )
] ]
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu () editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()

42
src/Mtlstats/Menu/EditPlayer.hs
View File

@ -34,18 +34,18 @@ import Mtlstats.Types.Menu
-- | The 'Player' edit menu -- | The 'Player' edit menu
editPlayerMenu :: Menu () editPlayerMenu :: Menu ()
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map editPlayerMenu = Menu "EDIT PLAYER" () $ map
(\(ch, label, action) -> MenuItem ch label $ modify action) (\(ch, label, action) -> MenuItem ch label $ modify action)
-- key, label, value -- key, label, value
[ ( '1', "Edit number", set EPNumber ) [ ( 'A', "EDIT NUMBER", set EPNumber )
, ( '2', "Edit name", set EPName ) , ( 'B', "EDIT NAME", set EPName )
, ( '3', "Edit position", set EPPosition ) , ( 'C', "EDIT POSITION", set EPPosition )
, ( '4', "Toggle rookie flag", toggleRookie ) , ( 'D', "TOGGLE ROOKIE FLAG", toggleRookie )
, ( '5', "Toggle active flag", toggleActive ) , ( 'E', "TOGGLE ACTIVE FLAG", toggleActive )
, ( '6', "Edit YTD stats", set EPYtd ) , ( 'F', "EDIT YTD STATS", set EPYtd )
, ( '7', "Edit lifetime stats", set EPLifetime ) , ( 'G', "EDIT LIFETIME STATS", set EPLifetime )
, ( 'R', "Return to Edit Menu", edit ) , ( 'R', "RETURN TO EDIT MENU", edit )
] ]
where where
@ -56,25 +56,25 @@ editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
-- | The 'Player' YTD stats edit menu -- | The 'Player' YTD stats edit menu
editPlayerYtdMenu :: Menu () editPlayerYtdMenu :: Menu ()
editPlayerYtdMenu = editMenu editPlayerYtdMenu = editMenu
"*** EDIT PLAYER YEAR-TO-DATE ***" "EDIT PLAYER YEAR-TO-DATE"
-- key, label, value -- key, label, value
[ ( '1', "Edit all YTD stats", EPYtdGoals True ) [ ( 'A', "EDIT ALL YTD STATS", EPYtdGoals True )
, ( '2', "Edit YTD goals", EPYtdGoals False ) , ( 'B', "EDIT YTD GOALS", EPYtdGoals False )
, ( '3', "Edit YTD assists", EPYtdAssists False ) , ( 'C', "EDIT YTD ASSISTS", EPYtdAssists False )
, ( '4', "Edit YTD penalty mins", EPYtdPMin ) , ( 'D', "EDIT YTD PENALTY MINS", EPYtdPMin )
, ( 'R', "Return to player edit menu", EPMenu ) , ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu )
] ]
-- | The 'Player' lifetime stats edit menu -- | The 'Player' lifetime stats edit menu
editPlayerLtMenu :: Menu () editPlayerLtMenu :: Menu ()
editPlayerLtMenu = editMenu editPlayerLtMenu = editMenu
"*** EDIT PLAYER LIFETIME ***" "EDIT PLAYER LIFETIME"
-- key, label, value -- key, label, value
[ ( '1', "Edit all lifetime stats", EPLtGoals True ) [ ( 'A', "EDIT ALL LIFETIME STATS", EPLtGoals True )
, ( '2', "Edit lifetime goals", EPLtGoals False ) , ( 'B', "EDIT LIFETIME GOALS", EPLtGoals False )
, ( '3', "Edit lifetime assits", EPLtAssists False ) , ( 'C', "EDIT LIFETIME ASSITS", EPLtAssists False )
, ( '4', "Edit lifetime penalty mins", EPLtPMin ) , ( 'D', "EDIT LIFETIME PENALTY MINS", EPLtPMin )
, ( 'R', "Return to edit player menu", EPMenu ) , ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu )
] ]
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu () editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()

22
src/Mtlstats/Menu/EditStandings.hs
View File

@ -32,12 +32,12 @@ import Mtlstats.Actions.EditStandings
import Mtlstats.Types.Menu import Mtlstats.Types.Menu
editStandingsMenu :: Menu () editStandingsMenu :: Menu ()
editStandingsMenu = Menu "*** EDIT STANDINGS ***" () editStandingsMenu = Menu "EDIT STANDINGS" ()
[ MenuItem '1' "Edit home standings" $ [ MenuItem 'A' "EDIT HOME STANDINGS" $
modify editHomeStandings modify editHomeStandings
, MenuItem '2' "Edit road standings" $ , MenuItem 'B' "EDIT ROAD STANDINGS" $
modify editAwayStandings modify editAwayStandings
, MenuItem 'R' "Return to main menu" $ , MenuItem 'R' "RETURN TO MAIN MENU" $
modify backHome modify backHome
] ]
@ -48,17 +48,17 @@ editAwayStandingsMenu :: Menu ()
editAwayStandingsMenu = subMenu "ROAD" editAwayStandingsMenu = subMenu "ROAD"
subMenu :: String -> Menu () subMenu :: String -> Menu ()
subMenu str = Menu ("*** " ++ str ++ " STANDINGS ***") () subMenu str = Menu (str ++ " STANDINGS") ()
[ MenuItem '1' "Edit wins" $ [ MenuItem 'W' "EDIT WINS" $
modify editWins modify editWins
, MenuItem '2' "Edit losses" $ , MenuItem 'L' "EDIT LOSSES" $
modify editLosses modify editLosses
, MenuItem '3' "Edit overtime games" $ , MenuItem 'O' "EDIT OVERTIME GAMES" $
modify editOvertime modify editOvertime
, MenuItem '4' "Edit goals for" $ , MenuItem 'F' "EDIT GOALS FOR" $
modify editGoalsFor modify editGoalsFor
, MenuItem '5' "Edit goals against" $ , MenuItem 'A' "EDIT GOALS AGAINST" $
modify editGoalsAgainst modify editGoalsAgainst
, MenuItem 'R' "Return to edit standings menu" $ , MenuItem 'R' "RETURN TO EDIT STANDINGS MENU" $
modify editStandings modify editStandings
] ]

14
src/Mtlstats/Types/Menu.hs
View File

@ -39,6 +39,7 @@ module Mtlstats.Types.Menu (
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses) import Lens.Micro.TH (makeLenses)
import Mtlstats.Format
import Mtlstats.Types import Mtlstats.Types
-- | Defines a menu -- | Defines a menu
@ -65,8 +66,15 @@ makeLenses ''Menu
makeLenses ''MenuItem makeLenses ''MenuItem
instance Show (Menu a) where instance Show (Menu a) where
show m = m ^. menuTitle ++ "\n" ++ items show m = unlines
where items = unlines $ map show $ m ^. menuItems $ [ m^.menuTitle
, ""
]
++ body
where
body = map (left width) items
width = maximum $ map length items
items = map show $ m^.menuItems
instance Show (MenuItem a) where instance Show (MenuItem a) where
show i = [i ^. miKey] ++ ") " ++ i ^. miDescription show i = [i ^. miKey] ++ ": " ++ i ^. miDescription

10
test/Types/MenuSpec.hs
View File

@ -37,11 +37,11 @@ showSpec :: Spec
showSpec = describe "show" $ showSpec = describe "show" $
it "should display correctly" $ let it "should display correctly" $ let
menu = Menu "Foo" () menu = Menu "Foo" ()
[ MenuItem '1' "Item 1" $ return () [ MenuItem '1' "foo" $ return ()
, MenuItem '2' "Item 2" $ return () , MenuItem '2' "bar baz" $ return ()
] ]
expected = expected =
"Foo\n\ "Foo\n\n\
\1) Item 1\n\ \1: foo \n\
\2) Item 2\n" \2: bar baz\n"
in show menu `shouldBe` expected in show menu `shouldBe` expected