From 72b6f05700be449955a0b6c7480b195b676cba1a Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 22 Jan 2020 20:59:09 -0500 Subject: [PATCH 1/4] changed menu style ...to be closer to the original program's menu style --- src/Mtlstats/Menu.hs | 62 +++++++++++++++--------------- src/Mtlstats/Menu/EditGoalie.hs | 56 +++++++++++++-------------- src/Mtlstats/Menu/EditPlayer.hs | 42 ++++++++++---------- src/Mtlstats/Menu/EditStandings.hs | 22 +++++------ src/Mtlstats/Types/Menu.hs | 4 +- test/Types/MenuSpec.hs | 6 +-- 6 files changed, 96 insertions(+), 96 deletions(-) diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index 3880787..c2caa12 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -102,56 +102,56 @@ menuHandler m _ = return $ m^.menuDefault -- | The main menu mainMenu :: Menu Bool -mainMenu = Menu "*** MAIN MENU ***" True - [ MenuItem '1' "New Season" $ +mainMenu = Menu "MASTER MENU" True + [ MenuItem 'A' "NEW SEASON" $ modify startNewSeason >> return True - , MenuItem '2' "New Game" $ + , MenuItem 'B' "NEW GAME" $ modify startNewGame >> return True - , MenuItem '3' "Edit" $ + , MenuItem 'C' "EDIT MENU" $ modify edit >> return True - , MenuItem 'X' "Exit" $ + , MenuItem 'E' "EXIT" $ saveDatabase dbFname >> return False ] -- | The new season menu newSeasonMenu :: Menu () -newSeasonMenu = Menu "*** SEASON TYPE ***" () - [ MenuItem 'R' "Regular Season" $ modify +newSeasonMenu = Menu "SEASON TYPE" () + [ MenuItem 'R' "REGULAR SEASON" $ modify $ resetYtd . clearRookies . resetStandings . startNewGame - , MenuItem 'P' "Playoffs" $ modify + , MenuItem 'P' "PLAYOFFS" $ modify $ resetStandings . startNewGame ] -- | Requests the month in which the game took place gameMonthMenu :: Menu () -gameMonthMenu = Menu "Month:" () $ map +gameMonthMenu = Menu "MONTH:" () $ map (\(ch, name, val) -> MenuItem ch name $ modify $ progMode.gameStateL.gameMonth ?~ val) - [ ( 'A', "January", 1 ) - , ( 'B', "February", 2 ) - , ( 'C', "March", 3 ) - , ( 'D', "April", 4 ) - , ( 'E', "May", 5 ) - , ( 'F', "June", 6 ) - , ( 'G', "July", 7 ) - , ( 'H', "August", 8 ) - , ( 'I', "September", 9 ) - , ( 'J', "October", 10 ) - , ( 'K', "November", 11 ) - , ( 'L', "December", 12 ) + [ ( 'A', "JANUARY", 1 ) + , ( 'B', "FEBRUARY", 2 ) + , ( 'C', "MARCH", 3 ) + , ( 'D', "APRIL", 4 ) + , ( 'E', "MAY", 5 ) + , ( 'F', "JUNE", 6 ) + , ( 'G', "JULY", 7 ) + , ( 'H', "AUGUST", 8 ) + , ( 'I', "SEPTEMBER", 9 ) + , ( 'J', "OCTOBER", 10 ) + , ( 'K', "NOVEMBER", 11 ) + , ( 'L', "DECEMBER", 12 ) ] -- | The game type menu (home/away) gameTypeMenu :: Menu () -gameTypeMenu = Menu "Game type:" () - [ MenuItem '1' "Home Game" $ +gameTypeMenu = Menu "GAME TYPE:" () + [ MenuItem 'H' "HOME GAME" $ modify $ progMode.gameStateL.gameType ?~ HomeGame - , MenuItem '2' "Away Game" $ + , MenuItem 'A' "AWAY GAME" $ modify $ progMode.gameStateL.gameType ?~ AwayGame ] @@ -172,17 +172,17 @@ gameGoalieMenu s = let -- | The edit menu editMenu :: Menu () -editMenu = Menu "*** EDIT ***" () - [ MenuItem '1' "Create Player" $ +editMenu = Menu "EDIT MENU" () + [ MenuItem 'A' "CREATE PLAYER" $ modify createPlayer - , MenuItem '2' "Create Goalie" $ + , MenuItem 'B' "CREATE GOALIE" $ modify createGoalie - , MenuItem '3' "Edit Player" $ + , MenuItem 'C' "EDIT PLAYER" $ modify editPlayer - , MenuItem '4' "Edit Goalie" $ + , MenuItem 'D' "EDIT GOALIE" $ modify editGoalie - , MenuItem '5' "Edit Standings" $ + , MenuItem 'E' "EDIT STANDINGS" $ modify editStandings - , MenuItem 'R' "Return to Main Menu" $ + , MenuItem 'R' "RETURN TO MAIN MENU" $ modify backHome ] diff --git a/src/Mtlstats/Menu/EditGoalie.hs b/src/Mtlstats/Menu/EditGoalie.hs index fae6caf..5b5b888 100644 --- a/src/Mtlstats/Menu/EditGoalie.hs +++ b/src/Mtlstats/Menu/EditGoalie.hs @@ -34,17 +34,17 @@ import Mtlstats.Types.Menu -- | The 'Goalie' edit menu editGoalieMenu :: Menu () -editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map +editGoalieMenu = Menu "EDIT GOALTENDER" () $ map (\(ch, label, action) -> MenuItem ch label $ modify action) -- key, label, value - [ ( '1', "Edit number", set EGNumber ) - , ( '2', "Edit name", set EGName ) - , ( '3', "Toggle rookie flag", toggleRookie ) - , ( '4', "Toggle active flag", toggleActive ) - , ( '5', "Edit YTD stats", set EGYtd ) - , ( '6', "Edit Lifetime stats", set EGLifetime ) - , ( 'R', "Return to Edit Menu", edit ) + [ ( 'A', "EDIT NUMBER", set EGNumber ) + , ( 'B', "EDIT NAME", set EGName ) + , ( 'C', "TOGGLE ROOKIE FLAG", toggleRookie ) + , ( 'D', "TOGGLE ACTIVE FLAG", toggleActive ) + , ( 'E', "EDIT YTD STATS", set EGYtd ) + , ( 'F', "EDIT LIFETIME STATS", set EGLifetime ) + , ( 'R', "RETURN TO EDIT MENU", edit ) ] where @@ -54,33 +54,33 @@ editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map -- | The 'Goalie' YTD edit menu editGoalieYtdMenu :: Menu () -editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***" +editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE" -- key, label, value - [ ( '1', "Edit all YTD stats", EGYtdGames True ) - , ( '2', "Edit YTD games", EGYtdGames False ) - , ( '3', "Edit YTD minutes", EGYtdMins False ) - , ( '4', "Edit YTD goals", EGYtdGoals False ) - , ( '5', "Edit YTD shutouts", EGYtdShutouts False ) - , ( '6', "Edit YTD wins", EGYtdWins False ) - , ( '7', "Edit YTD losses", EGYtdLosses False ) - , ( '8', "Edit YTD ties", EGYtdTies ) - , ( 'R', "Return to edit menu", EGMenu ) + [ ( 'A', "EDIT ALL YTD STATS", EGYtdGames True ) + , ( 'B', "EDIT YTD GAMES", EGYtdGames False ) + , ( 'C', "EDIT YTD MINUTES", EGYtdMins False ) + , ( 'D', "EDIT YTD GOALS", EGYtdGoals False ) + , ( 'E', "EDIT YTD SHUTOUTS", EGYtdShutouts False ) + , ( 'F', "EDIT YTD WINS", EGYtdWins False ) + , ( 'G', "EDIT YTD LOSSES", EGYtdLosses False ) + , ( 'H', "EDIT YTD TIES", EGYtdTies ) + , ( 'R', "RETURN TO EDIT MENU", EGMenu ) ] -- | The 'Goalie' lifetime edit menu editGoalieLtMenu :: Menu () editGoalieLtMenu = editMenu - "*** EDIT GOALTENDER LIFETIME ***" + "EDIT GOALTENDER LIFETIME" -- key, label, value - [ ( '1', "Edit all lifetime stats", EGLtGames True ) - , ( '2', "Edit lifetime games", EGLtGames False ) - , ( '3', "Edit lifetime minutes", EGLtMins False ) - , ( '4', "Edit lifetime goals", EGLtGoals False ) - , ( '5', "Edit lifetime shutouts", EGLtShutouts False ) - , ( '6', "Edit lifetime wins", EGLtWins False ) - , ( '7', "Edit lifetime losses", EGLtLosses False ) - , ( '8', "Edit lifetime ties", EGLtTies ) - , ( 'R', "Return to edit menu", EGMenu ) + [ ( 'A', "EDIT ALL LIFETIME STATS", EGLtGames True ) + , ( 'B', "EDIT LIFETIME GAMES", EGLtGames False ) + , ( 'C', "EDIT LIFETIME MINUTES", EGLtMins False ) + , ( 'D', "EDIT LIFETIME GOALS", EGLtGoals False ) + , ( 'E', "EDIT LIFETIME SHUTOUTS", EGLtShutouts False ) + , ( 'F', "EDIT LIFETIME WINS", EGLtWins False ) + , ( 'G', "EDIT LIFETIME LOSSES", EGLtLosses False ) + , ( 'H', "EDIT LIFETIME TIES", EGLtTies ) + , ( 'R', "RETURN TO EDIT MENU", EGMenu ) ] editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu () diff --git a/src/Mtlstats/Menu/EditPlayer.hs b/src/Mtlstats/Menu/EditPlayer.hs index 69c25fe..e603622 100644 --- a/src/Mtlstats/Menu/EditPlayer.hs +++ b/src/Mtlstats/Menu/EditPlayer.hs @@ -34,18 +34,18 @@ import Mtlstats.Types.Menu -- | The 'Player' edit menu editPlayerMenu :: Menu () -editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map +editPlayerMenu = Menu "EDIT PLAYER" () $ map (\(ch, label, action) -> MenuItem ch label $ modify action) -- key, label, value - [ ( '1', "Edit number", set EPNumber ) - , ( '2', "Edit name", set EPName ) - , ( '3', "Edit position", set EPPosition ) - , ( '4', "Toggle rookie flag", toggleRookie ) - , ( '5', "Toggle active flag", toggleActive ) - , ( '6', "Edit YTD stats", set EPYtd ) - , ( '7', "Edit lifetime stats", set EPLifetime ) - , ( 'R', "Return to Edit Menu", edit ) + [ ( 'A', "EDIT NUMBER", set EPNumber ) + , ( 'B', "EDIT NAME", set EPName ) + , ( 'C', "EDIT POSITION", set EPPosition ) + , ( 'D', "TOGGLE ROOKIE FLAG", toggleRookie ) + , ( 'E', "TOGGLE ACTIVE FLAG", toggleActive ) + , ( 'F', "EDIT YTD STATS", set EPYtd ) + , ( 'G', "EDIT LIFETIME STATS", set EPLifetime ) + , ( 'R', "RETURN TO EDIT MENU", edit ) ] where @@ -56,25 +56,25 @@ editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map -- | The 'Player' YTD stats edit menu editPlayerYtdMenu :: Menu () editPlayerYtdMenu = editMenu - "*** EDIT PLAYER YEAR-TO-DATE ***" + "EDIT PLAYER YEAR-TO-DATE" -- key, label, value - [ ( '1', "Edit all YTD stats", EPYtdGoals True ) - , ( '2', "Edit YTD goals", EPYtdGoals False ) - , ( '3', "Edit YTD assists", EPYtdAssists False ) - , ( '4', "Edit YTD penalty mins", EPYtdPMin ) - , ( 'R', "Return to player edit menu", EPMenu ) + [ ( 'A', "EDIT ALL YTD STATS", EPYtdGoals True ) + , ( 'B', "EDIT YTD GOALS", EPYtdGoals False ) + , ( 'C', "EDIT YTD ASSISTS", EPYtdAssists False ) + , ( 'D', "EDIT YTD PENALTY MINS", EPYtdPMin ) + , ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu ) ] -- | The 'Player' lifetime stats edit menu editPlayerLtMenu :: Menu () editPlayerLtMenu = editMenu - "*** EDIT PLAYER LIFETIME ***" + "EDIT PLAYER LIFETIME" -- key, label, value - [ ( '1', "Edit all lifetime stats", EPLtGoals True ) - , ( '2', "Edit lifetime goals", EPLtGoals False ) - , ( '3', "Edit lifetime assits", EPLtAssists False ) - , ( '4', "Edit lifetime penalty mins", EPLtPMin ) - , ( 'R', "Return to edit player menu", EPMenu ) + [ ( 'A', "EDIT ALL LIFETIME STATS", EPLtGoals True ) + , ( 'B', "EDIT LIFETIME GOALS", EPLtGoals False ) + , ( 'C', "EDIT LIFETIME ASSITS", EPLtAssists False ) + , ( 'D', "EDIT LIFETIME PENALTY MINS", EPLtPMin ) + , ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu ) ] editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu () diff --git a/src/Mtlstats/Menu/EditStandings.hs b/src/Mtlstats/Menu/EditStandings.hs index 6e41392..b57b1fd 100644 --- a/src/Mtlstats/Menu/EditStandings.hs +++ b/src/Mtlstats/Menu/EditStandings.hs @@ -32,12 +32,12 @@ import Mtlstats.Actions.EditStandings import Mtlstats.Types.Menu editStandingsMenu :: Menu () -editStandingsMenu = Menu "*** EDIT STANDINGS ***" () - [ MenuItem '1' "Edit home standings" $ +editStandingsMenu = Menu "EDIT STANDINGS" () + [ MenuItem 'A' "EDIT HOME STANDINGS" $ modify editHomeStandings - , MenuItem '2' "Edit road standings" $ + , MenuItem 'B' "EDIT ROAD STANDINGS" $ modify editAwayStandings - , MenuItem 'R' "Return to main menu" $ + , MenuItem 'R' "RETURN TO MAIN MENU" $ modify backHome ] @@ -48,17 +48,17 @@ editAwayStandingsMenu :: Menu () editAwayStandingsMenu = subMenu "ROAD" subMenu :: String -> Menu () -subMenu str = Menu ("*** " ++ str ++ " STANDINGS ***") () - [ MenuItem '1' "Edit wins" $ +subMenu str = Menu (str ++ " STANDINGS") () + [ MenuItem 'W' "EDIT WINS" $ modify editWins - , MenuItem '2' "Edit losses" $ + , MenuItem 'L' "EDIT LOSSES" $ modify editLosses - , MenuItem '3' "Edit overtime games" $ + , MenuItem 'O' "EDIT OVERTIME GAMES" $ modify editOvertime - , MenuItem '4' "Edit goals for" $ + , MenuItem 'F' "EDIT GOALS FOR" $ modify editGoalsFor - , MenuItem '5' "Edit goals against" $ + , MenuItem 'A' "EDIT GOALS AGAINST" $ modify editGoalsAgainst - , MenuItem 'R' "Return to edit standings menu" $ + , MenuItem 'R' "RETURN TO EDIT STANDINGS MENU" $ modify editStandings ] diff --git a/src/Mtlstats/Types/Menu.hs b/src/Mtlstats/Types/Menu.hs index e0091d2..2de5055 100644 --- a/src/Mtlstats/Types/Menu.hs +++ b/src/Mtlstats/Types/Menu.hs @@ -65,8 +65,8 @@ makeLenses ''Menu makeLenses ''MenuItem instance Show (Menu a) where - show m = m ^. menuTitle ++ "\n" ++ items + show m = m ^. menuTitle ++ "\n\n" ++ items where items = unlines $ map show $ m ^. menuItems instance Show (MenuItem a) where - show i = [i ^. miKey] ++ ") " ++ i ^. miDescription + show i = [i ^. miKey] ++ ": " ++ i ^. miDescription diff --git a/test/Types/MenuSpec.hs b/test/Types/MenuSpec.hs index 069bea3..6b95dc4 100644 --- a/test/Types/MenuSpec.hs +++ b/test/Types/MenuSpec.hs @@ -41,7 +41,7 @@ showSpec = describe "show" $ , MenuItem '2' "Item 2" $ return () ] expected = - "Foo\n\ - \1) Item 1\n\ - \2) Item 2\n" + "Foo\n\n\ + \1: Item 1\n\ + \2: Item 2\n" in show menu `shouldBe` expected From d6ae171dc8d9c8cb863ceabf8e7b2adedc362f1c Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 22 Jan 2020 21:10:21 -0500 Subject: [PATCH 2/4] pad menu selections to same width --- src/Mtlstats/Types/Menu.hs | 12 ++++++++++-- test/Types/MenuSpec.hs | 8 ++++---- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/Mtlstats/Types/Menu.hs b/src/Mtlstats/Types/Menu.hs index 2de5055..b0cdb31 100644 --- a/src/Mtlstats/Types/Menu.hs +++ b/src/Mtlstats/Types/Menu.hs @@ -39,6 +39,7 @@ module Mtlstats.Types.Menu ( import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) +import Mtlstats.Format import Mtlstats.Types -- | Defines a menu @@ -65,8 +66,15 @@ makeLenses ''Menu makeLenses ''MenuItem instance Show (Menu a) where - show m = m ^. menuTitle ++ "\n\n" ++ items - where items = unlines $ map show $ m ^. menuItems + show m = unlines + $ [ m^.menuTitle + , "" + ] + ++ body + where + body = map (left width) items + width = maximum $ map length items + items = map show $ m^.menuItems instance Show (MenuItem a) where show i = [i ^. miKey] ++ ": " ++ i ^. miDescription diff --git a/test/Types/MenuSpec.hs b/test/Types/MenuSpec.hs index 6b95dc4..6247b64 100644 --- a/test/Types/MenuSpec.hs +++ b/test/Types/MenuSpec.hs @@ -37,11 +37,11 @@ showSpec :: Spec showSpec = describe "show" $ it "should display correctly" $ let menu = Menu "Foo" () - [ MenuItem '1' "Item 1" $ return () - , MenuItem '2' "Item 2" $ return () + [ MenuItem '1' "foo" $ return () + , MenuItem '2' "bar baz" $ return () ] expected = "Foo\n\n\ - \1: Item 1\n\ - \2: Item 2\n" + \1: foo \n\ + \2: bar baz\n" in show menu `shouldBe` expected From 04ba17324e1eef0797ff633eaa63c81be1912d20 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 22 Jan 2020 21:23:32 -0500 Subject: [PATCH 3/4] centre menus horizontally --- src/Mtlstats/Menu.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index c2caa12..4e4db16 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -46,6 +46,7 @@ import Mtlstats.Actions import qualified Mtlstats.Actions.NewGame.GoalieInput as GI import Mtlstats.Actions.EditStandings import Mtlstats.Config +import Mtlstats.Format import Mtlstats.Types import Mtlstats.Types.Menu import Mtlstats.Util @@ -89,7 +90,11 @@ menuStateController menuFunc = Controller -- | The draw function for a 'Menu' drawMenu :: Menu a -> C.Update C.CursorMode 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 -- | The event handler for a 'Menu' From de56f4f94db4117b17c1ce6559ff4e23cf66186f Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 22 Jan 2020 21:43:09 -0500 Subject: [PATCH 4/4] updated change log --- ChangeLog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/ChangeLog.md b/ChangeLog.md index e6e7819..4577618 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -6,6 +6,7 @@ - Save a copy of the database on new season - Implemented game standings editing - Added title screen +- Changed sytling of menus ## 0.10.0 - Don't show player number zero in reports