don't scroll past top of page

This commit is contained in:
Jonathan Lamothe 2019-10-15 00:16:44 -04:00
parent a91ed5afb3
commit 363d0cb2d3
3 changed files with 40 additions and 2 deletions

View File

@ -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

View File

@ -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

View File

@ -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