diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 89e129b..106791f 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -19,10 +19,14 @@ along with this program. If not, see . -} +{-# LANGUAGE LambdaCase #-} + module Mtlstats.Actions ( startNewSeason , resetYtd , startNewGame + , addChar + , removeChar ) where import Lens.Micro (over, (&), (.~), (?~), (%~)) @@ -44,3 +48,13 @@ startNewGame :: ProgState -> ProgState startNewGame = (progMode .~ NewGame newGameState) . (database . dbGames %~ succ) + +-- | Adds a character to the input buffer +addChar :: Char -> ProgState -> ProgState +addChar c = inputBuffer %~ (++[c]) + +-- | Removes a character from the input buffer (if possible) +removeChar :: ProgState -> ProgState +removeChar = inputBuffer %~ \case + "" -> "" + str -> init str diff --git a/src/Mtlstats/Events.hs b/src/Mtlstats/Events.hs index bebbc02..602a8c9 100644 --- a/src/Mtlstats/Events.hs +++ b/src/Mtlstats/Events.hs @@ -30,6 +30,7 @@ import qualified UI.NCurses as C import Mtlstats.Actions import Mtlstats.Menu +import Mtlstats.Prompt import Mtlstats.Types -- | Event handler @@ -41,6 +42,10 @@ handleEvent e = gets (view progMode) >>= \case MainMenu -> menuHandler mainMenu e NewSeason -> menuHandler newSeasonMenu e >> return True NewGame gs - | null $ gs ^. gameType -> - menuHandler gameTypeMenu e >> return True + | null $ gs ^. gameType -> do + menuHandler gameTypeMenu e + return True + | null $ gs ^. homeScore -> do + promptHandler homeScorePrompt e + return True | otherwise -> undefined diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index a910ca8..7385909 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -38,8 +38,10 @@ import Mtlstats.Types import Mtlstats.Types.Menu -- | The draw function for a 'Menu' -drawMenu :: Menu a -> C.Update () -drawMenu = C.drawString . show +drawMenu :: Menu a -> C.Update C.CursorMode +drawMenu m = do + C.drawString $ show m + return C.CursorInvisible -- | The event handler for a 'Menu' menuHandler :: Menu a -> C.Event -> Action a diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs new file mode 100644 index 0000000..a70eed9 --- /dev/null +++ b/src/Mtlstats/Prompt.hs @@ -0,0 +1,81 @@ +{- | + +mtlstats +Copyright (C) 2019 Rhéal Lamothe + + +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 . + +-} + +module Mtlstats.Prompt ( + -- * Prompt Functions + drawPrompt, + promptHandler, + numPrompt, + -- * Individual prompts + homeScorePrompt +) where + +import Control.Monad (when) +import Control.Monad.Trans.State (gets, modify) +import Data.Char (isDigit, toUpper) +import Data.Foldable (forM_) +import Lens.Micro ((^.), (.~), (?~)) +import Lens.Micro.Extras (view) +import Text.Read (readMaybe) +import qualified UI.NCurses as C + +import Mtlstats.Actions +import Mtlstats.Types + +-- | 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 (C.KeyFunction k)) = + promptFunctionKey p k +promptHandler _ _ = return () + +-- | Builds a numeric prompt +numPrompt + :: String + -- ^ The prompt string + -> (Int -> Action ()) + -- ^ The callback function for the result + -> Prompt +numPrompt pStr act = Prompt + { promptDrawer = \s -> C.drawString $ pStr ++ s ^. inputBuffer + , promptCharCheck = isDigit + , promptAction = \inStr -> forM_ (readMaybe inStr) act + , promptFunctionKey = const $ return () + } + +homeScorePrompt :: Prompt +homeScorePrompt = numPrompt "Home score: " $ + modify . (progMode . homeScoreL ?~) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 6aeb018..2184303 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -33,10 +33,12 @@ module Mtlstats.Types ( PlayerStats (..), Goalie (..), GoalieStats (..), + Prompt (..), -- * Lenses -- ** ProgState Lenses database, progMode, + inputBuffer, -- ** GameState Lenses gameType, homeScore, @@ -102,17 +104,19 @@ import Data.Aeson ) import Lens.Micro (Lens', lens, (&), (^.), (.~)) import Lens.Micro.TH (makeLenses) -import UI.NCurses (Curses) +import UI.NCurses (Curses, Update) -- | Action which maintains program state type Action a = StateT ProgState Curses a -- | Represents the program state data ProgState = ProgState - { _database :: Database + { _database :: Database -- ^ The data to be saved - , _progMode :: ProgMode + , _progMode :: ProgMode -- ^ The program's mode + , _inputBuffer :: String + -- ^ Buffer for user input } deriving (Eq, Show) -- | The game state @@ -308,6 +312,18 @@ instance ToJSON GoalieStats where "losses" .= l <> "ties" .= t +-- | Defines a user prompt +data Prompt = Prompt + { promptDrawer :: ProgState -> Update () + -- ^ Draws the prompt to thr screen + , promptCharCheck :: Char -> Bool + -- ^ Determines whether or not the character is valid + , promptAction :: String -> Action () + -- ^ Action to perform when the value is entered + , promptFunctionKey :: Integer -> Action () + -- ^ Action to perform when a function key is pressed + } + makeLenses ''ProgState makeLenses ''GameState makeLenses ''Database @@ -346,8 +362,9 @@ awayScoreL = lens -- | Constructor for a 'ProgState' newProgState :: ProgState newProgState = ProgState - { _database = newDatabase - , _progMode = MainMenu + { _database = newDatabase + , _progMode = MainMenu + , _inputBuffer = "" } -- | Constructor for a 'GameState' diff --git a/src/Mtlstats/UI.hs b/src/Mtlstats/UI.hs index c73962d..bf9de7c 100644 --- a/src/Mtlstats/UI.hs +++ b/src/Mtlstats/UI.hs @@ -21,22 +21,27 @@ along with this program. If not, see . module Mtlstats.UI (draw) where +import Control.Monad (void) import Lens.Micro ((^.)) import qualified UI.NCurses as C import Mtlstats.Menu +import Mtlstats.Prompt import Mtlstats.Types -- | Drawing function draw :: ProgState -> C.Curses () draw s = do + void $ C.setCursorMode C.CursorInvisible w <- C.defaultWindow - C.updateWindow w $ do + cm <- C.updateWindow w $ do C.clear case s ^. progMode of MainMenu -> drawMenu mainMenu NewSeason -> drawMenu newSeasonMenu NewGame gs - | null $ gs ^. gameType -> drawMenu gameTypeMenu - | otherwise ->undefined + | null $ gs ^. gameType -> drawMenu gameTypeMenu + | null $ gs ^. homeScore -> drawPrompt homeScorePrompt s + | otherwise -> undefined C.render + void $ C.setCursorMode cm diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index c046718..f1d513e 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -34,6 +34,8 @@ spec = describe "Mtlstats.Actions" $ do startNewSeasonSpec startNewGameSpec resetYtdSpec + addCharSpec + removeCharSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -101,6 +103,29 @@ resetYtdSpec = describe "resetYtd" $ lt ^. gsTies `shouldNotBe` 0) $ s ^. database . dbGoalies +addCharSpec :: Spec +addCharSpec = describe "addChar" $ + it "should add the character to the input buffer" $ let + s = newProgState + & inputBuffer .~ "foo" + & addChar 'd' + in s ^. inputBuffer `shouldBe` "food" + +removeCharSpec :: Spec +removeCharSpec = describe "removeChar" $ do + + context "empty" $ + it "should remove the character from the input buffer" $ let + s = removeChar newProgState + in s ^. inputBuffer `shouldBe` "" + + context "not empty" $ + it "should remove the character from the input buffer" $ let + s = newProgState + & inputBuffer .~ "foo" + & removeChar + in s ^. inputBuffer `shouldBe` "fo" + makePlayer :: IO Player makePlayer = Player <$> makeNum