diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 45109b0..7a9b686 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -38,6 +38,8 @@ module Mtlstats.Actions , resetGoalData , assignPMins , backHome + , scrollUp + , scrollDown ) where import Control.Monad.Trans.State (modify) @@ -237,3 +239,11 @@ backHome = (progMode .~ MainMenu) . (inputBuffer .~ "") . (scrollOffset .~ 0) + +-- | Scrolls the display up +scrollUp :: ProgState -> ProgState +scrollUp = scrollOffset %~ max 0 . pred + +-- | Scrolls the display down +scrollDown :: ProgState -> ProgState +scrollDown = scrollOffset %~ succ diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 2b40913..f8dd896 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -278,8 +278,8 @@ reportC = Controller return C.CursorInvisible , handleController = \e -> do case e of - C.EventSpecialKey C.KeyUpArrow -> modify $ scrollOffset %~ pred - C.EventSpecialKey C.KeyDownArrow -> modify $ scrollOffset %~ succ + C.EventSpecialKey C.KeyUpArrow -> modify scrollUp + C.EventSpecialKey C.KeyDownArrow -> modify scrollDown C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0 C.EventSpecialKey _ -> modify backHome C.EventCharacter _ -> modify backHome diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 5e4f747..b45da09 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -61,6 +61,8 @@ spec = describe "Mtlstats.Actions" $ do resetGoalDataSpec assignPMinsSpec backHomeSpec + scrollUpSpec + scrollDownSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -672,3 +674,29 @@ backHomeSpec = describe "backHome" $ do it "should reset the scroll offset" $ result^.scrollOffset `shouldBe` 0 + +scrollUpSpec :: Spec +scrollUpSpec = describe "scrollUp" $ do + + context "scrolled down" $ + it "should decrease the scroll offset by one" $ let + ps = newProgState & scrollOffset .~ 10 + ps' = scrollUp ps + in ps'^.scrollOffset `shouldBe` 9 + + context "at top" $ + it "should keep the scroll offset at zero" $ let + ps = scrollUp newProgState + in ps^.scrollOffset `shouldBe` 0 + + context "above top" $ + it "should return the scroll offset to zero" $ let + ps = newProgState & scrollOffset .~ (-10) + ps' = scrollUp ps + in ps'^.scrollOffset `shouldBe` 0 + +scrollDownSpec = describe "scrollDown" $ + it "should increase the scroll offset" $ let + ps = newProgState & scrollOffset .~ 10 + ps' = scrollDown ps + in ps'^.scrollOffset `shouldBe` 11