don't scroll past top of page
This commit is contained in:
parent
a91ed5afb3
commit
363d0cb2d3
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user